home *** CD-ROM | disk | FTP | other *** search
/ Encyclopedia of Graphics File Formats Companion / GFF_CD.ISO / software / mac / nihimage / nih_src.hqx / V1.54 Source / Graphics.p < prev    next >
Encoding:
Text File  |  1994-02-01  |  66.5 KB  |  2,495 lines
  1. unit Graphics;
  2.  
  3. {Graphics routines used by Image program}
  4.  
  5. interface
  6.  
  7.     uses
  8.         QuickDraw, Palettes, Picker, PrintTraps, globals, Utilities;
  9.  
  10.     procedure ShowLineWidth;
  11.     function GetInterpolatedPixel (x, y: real): real;
  12.     procedure GetObliqueLine (xstart, ystart, start: real; angle: extended; count: integer; var line: rLineType);
  13.     procedure GetLengthOrPerimeter (var ulength, clength: real);
  14.     procedure PlotLineProfile;
  15.     procedure PlotArbitraryLine;
  16.     procedure DrawPlot;
  17.     procedure UpdatePlotWindow;
  18.     procedure ShowValues;
  19.     procedure ComputePlotMinAndMax;
  20.     procedure SetupPlot (start: point; VerticalPlot: boolean);
  21.     procedure MakePlotWindow (PlotLeft, PlotTop, PlotWidth, PlotHeight: integer);
  22.     procedure DrawObject (obj: ObjectType; p1, p2: point);
  23.     procedure DrawTools;
  24.     function InvertingCalibrationFunction: boolean;
  25.     procedure DrawHistogram;
  26.     procedure DrawLabels (xL, yL, zL: str255);
  27.     procedure ShowNextImage;
  28.     procedure StackImages;
  29.     procedure TileImages;
  30.     function Duplicate (name: str255; SavingBlankField: boolean): boolean;
  31.     procedure InvertPic;
  32.     procedure ShowMessage (str: str255);
  33.     procedure ShowTime (StartTicks: LongInt; r: rect; str: str255);
  34.     procedure ShowFrameRate (str1: str255; StartTicks, nFrames: LongInt);
  35.     procedure ConvertHistoToText;
  36.     procedure ConvertPlotToText;
  37.     procedure ConvertCalibrationCurveToText;
  38.     procedure SetupUndoInfoRec;
  39.     procedure ScaleAndRotate;
  40.     procedure ActivateWindow;
  41.     procedure UpdateResultsWindow;
  42.     procedure ScrollResultsText;
  43.     procedure UpdateResultsScrollBars;
  44.     procedure InitResultsTextEdit (font, size: integer);
  45.     procedure DoMouseDownInResults (loc: point);
  46.     procedure AppendResults;
  47.     procedure DeleteLines (first, last: integer);
  48.     procedure UpdateList;
  49.     procedure SelectSlice (i: integer);
  50.     procedure ShowMeter;
  51.     procedure UpdateMeter (percentdone: integer; str: str255);
  52.     function RgnNotTooBig (Rgn1, Rgn2: RgnHandle): boolean;
  53.     procedure MakeCoordinatesRelative;
  54.     procedure MakeOutline (RoiKind: RoiTypeType);
  55.     procedure ConvertCoordinates;
  56.     function CoordinatesAvailable: boolean;
  57.     function CoordinatesAvailableMsg: boolean;
  58.     procedure DrawDropBox (r: rect);
  59.     function PopUpMenu (theMenu: MenuHandle; left, top, PopUpItem: integer): integer;
  60.     procedure GetDItemRect (d: DialogPtr; item: integer; var r: rect);
  61.     procedure DrawPopUpText (str: str255; r: rect);
  62.     procedure SetUProc (d: DialogPtr; item: integer; pptr: handle);
  63.  
  64.  
  65.  
  66. implementation
  67.  
  68.  
  69. {$PUSH}
  70. {$D-}
  71.  
  72.     procedure DrawJustifiedReal (x, y: integer; r: extended);
  73.   {Draws a right justified real number.}
  74.         var
  75.             str: str255;
  76.             digits: integer;
  77.     begin
  78.         if abs(r) >= 1000.0 then
  79.             digits := 0
  80.         else
  81.             digits := 2;
  82.         RealToString(r, 1, digits, str);
  83.         MoveTo(x - StringWidth(str), y);
  84.         DrawString(str);
  85.     end;
  86.  
  87.  
  88.     procedure DrawVerticalString (x, y: integer; str: str255);
  89.         var
  90.             i: integer;
  91.     begin
  92.         MoveTo(x, y);
  93.         for i := 1 to length(str) do begin
  94.                 MoveTo(x, y);
  95.                 DrawChar(str[i]);
  96.                 y := y + 9;
  97.             end;
  98.     end;
  99.  
  100.  
  101.     procedure LabelProfilePlot;
  102.         var
  103.             str: str255;
  104.             min, max: real;
  105.             x, y: integer;
  106.     begin
  107.         min := PlotMin;
  108.         max := PlotMax;
  109.         DrawJustifiedReal(PlotLeftMargin - 2, PlotHeight - PlotBottomMargin, min);
  110.         DrawJustifiedReal(PlotLeftMargin - 2, PlotTopMargin + 8, max);
  111.         y := PlotTopMargin + (PlotHeight - (PlotTopMargin + PlotBottomMargin)) div 2 - length(PlotYUnits) * 9 div 2 + 6;
  112.         DrawVerticalString(PlotLeftMargin - 15, y, PlotYUnits);
  113.         MoveTo(PlotLeftMargin, PlotHeight - PlotBottomMargin + 11);
  114.         DrawLong(0);
  115.         if PlotScale <> 0.0 then
  116.             RealToString((PlotCount - 1) * PlotScale, 1, Precision, str)
  117.         else
  118.             NumToString(PlotCount - 1, str);
  119.         MoveTo(PlotWidth - PlotRightMargin - StringWidth(str) + 4, PlotHeight - PlotBottomMargin + 11);
  120.         DrawString(str);
  121.         x := PlotRightMargin + (PlotWidth - (PlotRightMargin + PlotLeftMargin)) div 2 - StringWidth(str) div 2;
  122.         MoveTo(x, PlotHeight - PlotBottomMargin + 13);
  123.         DrawString(PlotXUnits);
  124.     end;
  125.  
  126.  
  127.     procedure LabelCalibrationPlot;
  128.         var
  129.             pbottom, hloc, vloc, i: integer;
  130.             letter: packed array[1..6] of char;
  131.     begin
  132.         pbottom := PlotHeight - PLotBottomMargin;
  133.         DrawJReal(PlotLeftMargin, PlotTopMargin + 4, MaxValue, 2);
  134.         DrawJReal(PlotLeftMargin, pbottom, MinValue, 2);
  135.         MoveTo(PlotLeftMargin - 3, pbottom + 10);
  136.         DrawString('0');
  137.         MoveTo(PlotWidth - PlotRightMargin - 14, pbottom + 10);
  138.         DrawString('255');
  139.         MoveTo(PlotLeftMargin + 15, PlotTopMargin + 15);
  140.         TextSize(12);
  141.         case info^.fit of
  142.             StraightLine: 
  143.                 DrawString('y=a+bx');
  144.             Poly2: 
  145.                 DrawString('y=a+bx+cx^2');
  146.             Poly3: 
  147.                 DrawString('y=a+bx+cx^2+dx^3');
  148.             Poly4: 
  149.                 DrawString('y=a+bx+cx^2+dx^3+ex^4');
  150.             Poly5: 
  151.                 DrawString('y=a+bx+cx^2+dx^3+ex^4+fx^5');
  152.             ExpoFit: 
  153.                 DrawString('y=aexp(bx)');
  154.             PowerFit: 
  155.                 DrawString('y=ax^b');
  156.             LogFit: 
  157.                 DrawString('y=aln(bx)');
  158.             RodbardFit: 
  159.                 DrawString('y=c*((a-x)/(x-d))^(1/b)');
  160.             UncalibratedOD: 
  161.                 DrawString('y=log10(255/(255-x))');
  162.             otherwise
  163.         end;
  164.         hloc := PlotWidth - PlotRightMargin + 5;
  165.         vloc := PlotTopMargin + 25;
  166.         letter := 'abcdef';
  167.         MoveTo(hloc, vloc);
  168.         with info^ do
  169.             for i := 1 to nCoefficients do begin
  170.                     MoveTo(hloc, vloc);
  171.                     TextSize(12);
  172.                     DrawString(letter[i]);
  173.                     DrawString('=');
  174.                     TextSize(9);
  175.                     DrawReal(Coefficient[i], 1, 8);
  176.                     vloc := vloc + 15;
  177.                 end;
  178.         if info^.fit <> UncalibratedOD then begin
  179.                 vloc := vloc + 25;
  180.                 MoveTo(hloc, vloc);
  181.                 DrawString('S.D.=');
  182.                 DrawReal(FitSD, 1, 4);
  183.                 vloc := vloc + 15;
  184.                 MoveTo(hloc, vloc);
  185.                 DrawString('R^2=');
  186.                 DrawReal(FitGoodness, 1, 4);
  187.             end;
  188.     end;
  189.  
  190.  
  191.     procedure DrawPlot;
  192.         var
  193.             fRect: rect;
  194.     begin
  195.         SetRect(fRect, PlotLeftMargin, PlotTopMargin, PlotWidth - PlotRightMargin, PlotHeight - PlotBottomMargin);
  196.         PenNormal;
  197.         FrameRect(fRect);
  198.         DrawPicture(PlotPICT, fRect);
  199.         TextFont(ApplFont);
  200.         TextSize(9);
  201.         if WindowPeek(PlotWindow)^.WindowKind = ProfilePlotKind then begin
  202.                 if DrawPlotLabels then
  203.                     LabelProfilePlot
  204.             end
  205.         else
  206.             LabelCalibrationPlot;
  207.     end;
  208.  
  209.  
  210.     procedure UpdatePlotWindow;
  211.     begin
  212.         SetPort(PlotWindow);
  213.         EraseRect(PlotWindow^.portRect);
  214.         DrawPlot;
  215.         DrawMyGrowIcon(PlotWindow);
  216.     end;
  217.  
  218.  
  219.     procedure MakePlotWindow; {(PlotLeft, PlotTop, PlotWidth, PlotHeight: integer)}
  220.         var
  221.             PLotRect, pwrect, dwrect, srect: rect;
  222.             overlapping: boolean;
  223.     begin
  224.         if PlotWindow = nil then begin
  225.                 SetRect(PlotRect, PlotLeft, PlotTop, PlotLeft + PlotWidth, PlotTop + PlotHeight);
  226.                 PlotWindow := NewWindow(nil, PlotRect, 'Plot', true, DocumentProc, nil, true, 0);
  227.             end
  228.         else begin
  229.                 GetWindowRect(PlotWindow, pwrect);
  230.                 GetWindowRect(info^.wptr, dwrect);
  231.                 overlapping := SectRect(pwrect, dwrect, srect);
  232.                 if overlapping then
  233.                     MoveWindow(PlotWindow, PlotLeft, PlotTop, false);
  234.                 SizeWindow(PlotWindow, PlotWidth, PlotHeight, false);
  235.             end;
  236.     end;
  237.  
  238.  
  239.     procedure GetDiagLine (start, finish: Point; var count: integer; var data: LineType; OptionKey: boolean);
  240.         var
  241.             sum: LongInt;
  242.             p: ptr;
  243.             deltax, deltay, xinc, yinc, accumulator, i: integer;
  244.             xloc, yloc, j: integer;
  245.             average: boolean;
  246.             buf, fline: LineType;
  247.     begin
  248.         average := LineWidth > 1;
  249.         if OptionKey and average then
  250.             for i := 0 to MaxLine do
  251.                 fline[i] := ForegroundIndex;
  252.         count := 0;
  253.         xloc := start.h;
  254.         yloc := start.v;
  255.         deltax := finish.h - xloc;
  256.         deltay := finish.v - yloc;
  257.         if (deltax = 0) and (deltay = 0) then begin
  258.                 data[count] := MyGetPixel(xloc, yloc);
  259.                 if OptionKey then
  260.                     PutPixel(xloc, yloc, ForegroundIndex);
  261.                 count := 1;
  262.                 exit(GetDiagLine);
  263.             end;
  264.         if deltax < 0 then begin
  265.                 xinc := -1;
  266.                 deltax := -deltax
  267.             end
  268.         else
  269.             xinc := 1;
  270.         if deltay < 0 then begin
  271.                 yinc := -1;
  272.                 deltay := -deltay
  273.             end
  274.         else
  275.             yinc := 1;
  276.         if DeltaX > DeltaY then begin {More horizontal}
  277.                 if average and (CurrentTool <> LineTool) then
  278.                     deltax := deltax + LineWidth;
  279.                 accumulator := deltax div 2;
  280.                 i := deltax;
  281.                 repeat
  282.                     if count < MaxLine then
  283.                         count := count + 1;
  284.                     accumulator := accumulator + deltay;
  285.                     if accumulator >= deltax then begin
  286.                             accumulator := accumulator - deltax;
  287.                             yloc := yloc + yinc
  288.                         end;
  289.                     xloc := xloc + xinc;
  290.                     if average then begin
  291.                             GetColumn(xloc, yloc, LineWidth, buf);
  292.                             if OptionKey then
  293.                                 PutColumn(xloc, yloc, LineWidth, fline);
  294.                             sum := 0;
  295.                             for j := 0 to LineWidth - 1 do
  296.                                 sum := sum + buf[j];
  297.                             data[count - 1] := round(sum / LineWidth);
  298.                         end
  299.                     else begin
  300.                             data[count - 1] := MyGetPixel(xloc, yloc);
  301.                             if OptionKey then
  302.                                 PutPixel(xloc, yloc, ForegroundIndex);
  303.                         end;
  304.                     i := i - 1;
  305.                 until i = 0
  306.             end
  307.         else begin          {More vertical}
  308.                 if average and (CurrentTool <> LineTool) then
  309.                     deltay := deltay + LineWidth;
  310.                 accumulator := deltay div 2;
  311.                 i := deltay;
  312.                 repeat
  313.                     if count < MaxLine then
  314.                         count := count + 1;
  315.                     accumulator := accumulator + deltax;
  316.                     if accumulator >= deltay then begin
  317.                             accumulator := accumulator - deltay;
  318.                             xloc := xloc + xinc
  319.                         end;
  320.                     yloc := yloc + yinc;
  321.                     if average then begin
  322.                             GetLine(xloc, yloc, LineWidth, buf);
  323.                             if OptionKey then
  324.                                 PutLine(xloc, yloc, LineWidth, fline);
  325.                             sum := 0;
  326.                             for j := 0 to LineWidth - 1 do
  327.                                 sum := sum + buf[j];
  328.                             data[count - 1] := round(sum / LineWidth);
  329.                         end
  330.                     else begin
  331.                             data[count - 1] := MyGetPixel(xloc, yloc);
  332.                             if OptionKey then
  333.                                 PutPixel(xloc, yloc, ForegroundIndex);
  334.                         end;
  335.                     i := i - 1;
  336.                 until i = 0
  337.             end;
  338.     end;
  339.  
  340.  
  341.     function GetInterpolatedPixel (x, y: real): real;
  342.         var
  343.             i, xbase, ybase: integer;
  344.             LowerLeft, LowerRight, UpperLeft, UpperRight: integer;
  345.             xfraction, yfraction, UpperAverage, LowerAverage: real;
  346.     begin
  347.         xbase := trunc(x);
  348.         ybase := trunc(y);
  349.         xFraction := x - xbase;
  350.         yFraction := y - ybase;
  351.         LowerLeft := MyGetPixel(xbase, ybase);
  352.         LowerRight := MyGetPixel(xbase + 1, ybase);
  353.         UpperRight := MyGetPixel(xbase + 1, ybase + 1);
  354.         UpperLeft := MyGetPixel(xbase, ybase + 1);
  355.         UpperAverage := UpperLeft + xfraction * (UpperRight - UpperLeft);
  356.         LowerAverage := LowerLeft + xfraction * (LowerRight - LowerLeft);
  357.         GetInterpolatedPixel := LowerAverage + yfraction * (UpperAverage - LowerAverage);
  358.     end;
  359.  
  360.  
  361.     function GetCInterpolatedPixel (x, y: real): real;
  362.         var
  363.             i, xbase, ybase: integer;
  364.             LowerLeft, LowerRight, UpperLeft, UpperRight: real;
  365.             xfraction, yfraction, UpperAverage, LowerAverage: real;
  366.     begin
  367.         xbase := trunc(x);
  368.         ybase := trunc(y);
  369.         xFraction := x - xbase;
  370.         yFraction := y - ybase;
  371.         LowerLeft := cvalue[MyGetPixel(xbase, ybase)];
  372.         LowerRight := cvalue[MyGetPixel(xbase + 1, ybase)];
  373.         UpperRight := cvalue[MyGetPixel(xbase + 1, ybase + 1)];
  374.         UpperLeft := cvalue[MyGetPixel(xbase, ybase + 1)];
  375.         UpperAverage := UpperLeft + xfraction * (UpperRight - UpperLeft);
  376.         LowerAverage := LowerLeft + xfraction * (LowerRight - LowerLeft);
  377.         GetCInterpolatedPixel := LowerAverage + yfraction * (UpperAverage - LowerAverage);
  378.     end;
  379.  
  380.  
  381.     procedure GetObliqueLine (xstart, ystart, start: real; angle: extended; count: integer; var line: rLineType);
  382.         var
  383.             i: integer;
  384.             x, y, xinc, yinc: extended;
  385.             IntegerStart: boolean;
  386.             tLine: LineType;
  387.     begin
  388.         IntegerStart := (xstart = trunc(xstart)) and (ystart = trunc(ystart));
  389.         if IntegerStart and (angle = 0.0) then begin
  390.                 GetLine(trunc(xstart), trunc(ystart), count, tLine);
  391.                 for i := 0 to count - 1 do
  392.                     line[i] := cvalue[tLine[i]];
  393.                 exit(GetObliqueLine);
  394.             end;
  395.         if IntegerStart and (angle = 270.0) then begin
  396.                 GetColumn(trunc(xstart), trunc(ystart), count, tLine);
  397.                 for i := 0 to count - 1 do
  398.                     line[i] := cvalue[tLine[i]];
  399.                 exit(GetObliqueLine);
  400.             end;
  401.         angle := (angle / 180.0) * pi;
  402.         xinc := cos(angle);
  403.         yinc := -sin(angle);
  404.         x := xstart + start * xinc;
  405.         y := ystart + start * yinc;
  406.         if info^.DensityCalibrated then
  407.             for i := 0 to count - 1 do begin
  408.                     line[i] := GetCInterpolatedPixel(x, y);
  409.                     x := x + xinc;
  410.                     y := y + yinc;
  411.                 end
  412.         else
  413.             for i := 0 to count - 1 do begin
  414.                     line[i] := GetInterpolatedPixel(x, y);
  415.                     x := x + xinc;
  416.                     y := y + yinc;
  417.                 end;
  418.     end;
  419.  
  420.  
  421.     procedure DrawTools;
  422.         var
  423.             tPort: GrafPtr;
  424.             tool: ToolType;
  425.             tpRect, sRect, dRect: rect;
  426.             hloc, vloc: integer;
  427.  
  428.         procedure CopyToolBits (src, dst: rect; CopyMode: integer);
  429.         begin
  430.             hlock(handle(CGrafPort(ToolWindow^).PortPixMap));
  431.             CopyBits(toolBits, BitMapHandle(CGrafPort(ToolWindow^).PortPixMap)^^, src, dst, CopyMode, nil);
  432.             hunlock(handle(CGrafPort(ToolWindow^).PortPixMap));
  433.         end;
  434.  
  435.     begin
  436.         GetPort(tPort);
  437.         SetPort(ToolWindow);
  438.         tpRect := CGrafPort(ToolWindow^).portRect;
  439.         pmForeColor(BlackIndex);
  440.         pmBackColor(WhiteIndex);
  441.         CopyToolBits(tpRect, tpRect, srcCopy);
  442.         case LOIType of
  443.             Straight: 
  444.                 ;
  445.             Freehand:  begin
  446.                     SetRect(sRect, 46, 92, 62, 106);
  447.                     hloc := 27;
  448.                     vloc := 92;
  449.                     SetRect(dRect, hloc, vloc, hloc + 16, vloc + 14);
  450.                     CopyToolBits(sRect, dRect, SrcCopy);
  451.                 end;
  452.             Segmented:  begin
  453.                     SetRect(sRect, 46, 108, 62, 122);
  454.                     hloc := 27;
  455.                     vloc := 92;
  456.                     SetRect(dRect, hloc, vloc, hloc + 16, vloc + 14);
  457.                     CopyToolBits(sRect, dRect, SrcCopy);
  458.                 end;
  459.         end;
  460.         InvertRect(ToolRect[CurrentTool]);
  461.         SetRect(sRect, 46, 226, 55, 233);
  462.         hloc := 2;
  463.         vloc := Lines[LineIndex].top - 4;
  464.         SetRect(dRect, hloc, vloc, hloc + 9, vloc + 7);
  465.         CopyToolBits(sRect, dRect, SrcCopy); {Check mark}
  466.         pmForeColor(ForegroundIndex);
  467.         SetRect(sRect, 46, 81, 57, 87);
  468.         hloc := 4;
  469.         vloc := 101;
  470.         SetRect(dRect, hloc, vloc, hloc + 11, vloc + 6);
  471.         CopyToolBits(sRect, dRect, SrcOr); {Brush color}
  472.         pmForeColor(BackgroundIndex);
  473.         SetRect(sRect, 46, 65, 61, 76);
  474.         hloc := 3;
  475.         vloc := 73;
  476.         SetRect(dRect, hloc, vloc, hloc + 15, vloc + 11);
  477.         CopyToolBits(sRect, dRect, SrcOr); {Eraser color}
  478.         SetPort(tPort);
  479.     end;
  480.  
  481.  
  482.     procedure ShowLineWidth;
  483.     begin
  484.         LineIndex := LineWidth;
  485.         if LineWidth = 6 then
  486.             LineIndex := 5;
  487.         if LineWidth > 6 then
  488.             LineIndex := 6;
  489.         DrawTools;
  490.     end;
  491.  
  492.  
  493.     procedure GetFatLine (xstart, ystart: real; angle: extended; count: integer; var line: rLineType);
  494.         var
  495.             i, j, xbase, ybase: integer;
  496.             x, y, xinc, yinc, pAngle, xinc2, yinc2: real;
  497.             sum, value: real;
  498.             add: boolean;
  499.     begin
  500.         add := (angle > 90.0) and (angle <= 270.0);
  501.         angle := (angle / 180.0) * pi;
  502.         xinc := cos(angle);
  503.         yinc := -sin(angle);
  504.         if add then
  505.             pAngle := angle + pi / 2.0
  506.         else
  507.             pAngle := angle - pi / 2.0;
  508.         xinc2 := cos(pAngle);
  509.         yinc2 := -sin(pAngle);
  510.         for i := 0 to count - 1 do begin
  511.                 x := xstart;
  512.                 y := ystart;
  513.                 sum := 0.0;
  514.                 for j := 1 to LineWidth do begin
  515.                         if info^.DensityCalibrated then
  516.                             value := GetCInterpolatedPixel(x, y)
  517.                         else
  518.                             value := GetInterpolatedPixel(x, y);
  519.                         sum := sum + value;
  520.                         x := x + xinc2;
  521.                         y := y + yinc2;
  522.                     end;
  523.                 line[i] := sum / LineWidth;
  524.                 xstart := xstart + xinc;
  525.                 ystart := ystart + yinc;
  526.             end;
  527.     end;
  528.  
  529.  
  530.     procedure ComputePlotMinAndMax;
  531.         var
  532.             i: integer;
  533.             temp: real;
  534.     begin
  535.         ActualPlotMin := 10e12;
  536.         ActualPlotMax := 10e-12;
  537.         for i := 0 to PlotCount - 1 do begin
  538.                 temp := PlotData^[i];
  539.                 if temp < ActualPlotMin then
  540.                     ActualPlotMin := temp;
  541.                 if temp > ActualPlotMax then
  542.                     ActualPlotMax := temp;
  543.             end;
  544.         if InvertPlots then
  545.             for i := 0 to PlotCount - 1 do
  546.                 PlotData^[i] := ActualPlotMax - (PlotData^[i] - ActualPlotMin);
  547.     end;
  548.  
  549.  
  550.     procedure SetupPlot (start: point; VerticalPlot: boolean);
  551.         const
  552.             MinWidth = 150;
  553.         var
  554.             fRect, trect: rect;
  555.             i, y, WindowWidth, fmax: integer;
  556.             SaveClipRegion: RgnHandle;
  557.             pt: point;
  558.             scale, vscale: real;
  559.             AutoScale: boolean;
  560.             index: UnsignedByte;
  561.     begin
  562.         with info^ do begin
  563.                 PlotLeftMargin := 38;
  564.                 PlotTopMargin := 10;
  565.                 PlotBottomMargin := 20;
  566.                 PlotRightMargin := 20;
  567.                 if FixedSizePlot then begin
  568.                         PlotWidth := ProfilePlotWidth;
  569.                         PlotHeight := ProfilePlotHeight
  570.                     end
  571.                 else begin
  572.                         PlotWidth := PlotCount * trunc(magnification + 0.5);
  573.                         if PlotWidth < MinWidth then
  574.                             PlotWidth := MinWidth;
  575.                         if PlotWidth + PlotRightMargin + PicLeftBase > ScreenWidth then
  576.                             PlotWidth := ScreenWidth - PlotRightMargin - PicLeftBase - 10;
  577.                         if PlotWidth > PicRect.right then
  578.                             PlotWidth := PicRect.right;
  579.                         PlotHeight := PlotWidth div 2;
  580.                         if PlotWidth > 300 then
  581.                             PlotHeight := PlotWidth div 3;
  582.                         if PlotWidth > 400 then
  583.                             PlotHeight := PlotWidth div 4;
  584.                     end;
  585.                 PlotWidth := PlotWidth + PlotLeftMargin + PlotRightMargin;
  586.                 PlotHeight := PlotHeight + PlotTopMargin + PlotBottomMargin;
  587.                 OffscreenToScreen(start);
  588.                 pt.h := start.h;
  589.                 pt.v := start.v + 40;
  590.                 SetPort(wptr);
  591.                 LocalToGlobal(pt);
  592.                 if VerticalPlot then
  593.                     PlotLeft := PicLeftBase
  594.                 else
  595.                     PlotLeft := pt.h - PlotLeftMargin;
  596.                 PlotTop := pt.v;
  597.                 if PlotLeft > (ScreenWidth - PlotWidth) then
  598.                     PlotLeft := ScreenWidth - PlotWidth - 10;
  599.                 if PlotTop < 60 then
  600.                     PlotTop := 60;
  601.                 if PlotTop > (ScreenHeight - PlotHeight) then
  602.                     PlotTop := ScreenHeight - PlotHeight - 10;
  603.                 if PlotTop < 60 then
  604.                     PlotTop := 60;
  605.                 MakePlotWindow(PlotLeft, PlotTop, PlotWidth, PlotHeight);
  606.                 if PlotWindow = nil then
  607.                     exit(SetupPlot);
  608.                 WindowPeek(PlotWindow)^.WindowKind := ProfilePlotKind;
  609.                 if SpatiallyCalibrated then begin
  610.                         PlotScale := 1 / xSpatialScale;
  611.                         if xUnit = 'inch' then
  612.                             PlotXUnits := 'Inches'
  613.                         else if xUnit = 'meter' then
  614.                             PlotXUnits := 'meters'
  615.                         else if xUnit = 'mile' then
  616.                             PlotXUnits := 'miles'
  617.                         else
  618.                             PlotXUnits := xUnit;
  619.                     end
  620.                 else begin
  621.                         PlotScale := 0.0;
  622.                         PlotXUnits := 'Pixels'
  623.                     end;
  624.                 if DensityCalibrated then
  625.                     PlotYUnits := UnitOfMeasure
  626.                 else
  627.                     PlotYUnits := '';
  628.                 if AutoScalePlots then begin
  629.                         PlotMin := ActualPlotMin;
  630.                         PlotMax := ActualPlotMax;
  631.                     end
  632.                 else begin
  633.                         PlotMin := ProfilePlotMin;
  634.                         PlotMax := ProfilePlotMax;
  635.                     end;
  636.                 fmax := PlotCount - 1;
  637.                 if (PlotMax - PlotMin) <> 0 then
  638.                     vscale := fmax / (PlotMax - PlotMin)
  639.                 else
  640.                     vscale := 1.0;
  641.                 scale := 2048.0 / PlotCount;  {This scaling needed to get around a 32-bit QD problem}
  642.                 if scale < 1.0 then
  643.                     scale := 1.0;
  644.                 fmax := round(fmax * scale);
  645.                 vscale := vscale * scale;
  646.                 SetRect(fRect, 0, 0, fmax, fmax);
  647.                 SetPort(PlotWindow);
  648.                 SaveClipRegion := PlotWindow^.ClipRgn;
  649.                 RectRgn(PlotWindow^.ClipRgn, fRect);
  650.                 PlotPICT := OpenPicture(fRect);
  651.                 PenNormal;
  652.                 if LinePlot then begin
  653.                         MoveTo(0, round(vscale * (PlotMax - PlotData^[0])));
  654.                         for i := 1 to PlotCount - 1 do
  655.                             LineTo(round(i * scale), round(vscale * (PlotMax - PlotData^[i])))
  656.                     end
  657.                 else
  658.                     for i := 1 to PlotCount - 1 do begin
  659.                             y := round(vscale * (PlotMax - PlotData^[i]));
  660.                             MoveTo(round(i * scale), y);
  661.                             LineTo(round(i * scale), y)
  662.                         end;
  663.                 ClosePicture;
  664.                 PlotWindow^.ClipRgn := SaveClipRegion;
  665.                 InvalRect(PlotWindow^.PortRect);
  666.                 SelectWindow(PlotWindow);
  667.             end;  {with}
  668.     end;
  669.  
  670.  
  671.     procedure PlotLineProfile;
  672.         var
  673.             x1, y1, x2, y2, ulength, clength: real;
  674.             start: point;
  675.     begin
  676.         GetLengthOrPerimeter(ulength, clength);
  677.         PlotCount := round(ulength);
  678.         if PlotCount = 0 then begin
  679.                 PutMessage('Line length is zero.');
  680.                 macro := false;
  681.                 exit(PlotLineProfile);
  682.             end;
  683.         GetLoi(x1, y1, x2, y2);
  684.         PlotAngle := info^.LAngle;
  685.         if LineWidth > 1 then
  686.             GetFatLine(x1, y1, PlotAngle, PlotCount, PlotData^)
  687.         else
  688.             GetObliqueLine(x1, y1, 0.0, PlotAngle, PlotCount, PlotData^);
  689.         PlotAvg := LineWidth;
  690.         PlotStart.h := round(x1);
  691.         PlotStart.v := round(y1);
  692.         ComputePlotMinAndMax;
  693.         if ShowPlot then
  694.             SetupPlot(PlotStart, false);
  695.     end;
  696.  
  697.  
  698.     function CoordinatesAvailable: boolean;
  699.         var
  700.             available: boolean;
  701.     begin
  702.         with info^.RoiRect do
  703.             available := (nCoordinates > 0) and ((right - left) = CoordinatesWidth) and ((bottom - top) = CoordinatesHeight) and (info^.RoiType = CoordinatesRoiType);
  704.         if AnalyzingParticles and (nCoordinates > 0) then
  705.             available := true;
  706.         CoordinatesAvailable := available;
  707.     end;
  708.  
  709.  
  710.     function CoordinatesAvailableMsg: boolean;
  711.         var
  712.             available: boolean;
  713.     begin
  714.         available := CoordinatesAvailable;
  715.         if not available then
  716.             PutMessage('XY coordinates are not available.');
  717.         CoordinatesAvailableMsg := available;
  718.     end;
  719.  
  720.  
  721.     function GetArbitraryLine (var count: integer; var pdata: rLineType): boolean;
  722.         var
  723.             angle, length, leftover: real;
  724.             i, j, ilength, xbase, ybase: integer;
  725.             x1, y1, x2, y2: LongInt;
  726.             data: rLineType;
  727.     begin
  728.         if not CoordinatesAvailableMsg or (nCoordinates < 2) then begin
  729.                 GetArbitraryLine := false;
  730.                 exit(GetArbitraryLine);
  731.             end;
  732.         count := 0;
  733.         length := 0.0;
  734.         leftover := 0.0;
  735.         with info^.RoiRect do begin
  736.                 xbase := left;
  737.                 ybase := top;
  738.             end;
  739.         for i := 2 to nCoordinates do begin
  740.                 x1 := xCoordinates^[i - 1] + xbase;
  741.                 y1 := yCoordinates^[i - 1] + ybase;
  742.                 x2 := xCoordinates^[i] + xbase;
  743.                 y2 := yCoordinates^[i] + ybase;
  744.                 length := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
  745.                 if length > 0.0 then begin
  746.                         length := length - LeftOver;
  747.                         ilength := round(length);
  748.                         if ilength > 0 then begin
  749.                                 GetAngle(x2 - x1, y1 - y2, angle);
  750.                                 GetObliqueLine(x1, y1, leftover, angle, ilength, data);
  751.                                 for j := 1 to ilength do begin
  752.                                         pdata[count] := data[j - 1];
  753.                                         count := count + 1;
  754.                                     end;
  755.                             end;
  756.                         leftover := length - ilength;
  757.                     end;
  758.             end;
  759.         GetArbitraryLine := true;
  760.     end;
  761.  
  762.  
  763.     procedure PlotArbitraryLine;
  764.         var
  765.             angle, length, leftover: real;
  766.             x1, y1, x2, y2, i, j, count: integer;
  767.             data: LineType;
  768.     begin
  769.         if not GetArbitraryLine(PlotCount, PlotData^) then
  770.             exit(PlotArbitraryLine);
  771.         PlotAvg := 1;
  772.         with info^.RoiRect do begin
  773.                 PlotStart.h := left;
  774.                 PlotStart.v := top;
  775.             end;
  776.         ComputePlotMinAndMax;
  777.         if ShowPlot then
  778.             SetupPlot(PlotStart, false);
  779.     end;
  780.  
  781.  
  782.     procedure FindIntegratedDensity (var IntDen, Background: extended);
  783.         var
  784.             i, MinLevel, MaxLevel, iback: integer;
  785.             MaxCount: LongInt;
  786.             h, h2: HistogramType;
  787.             sum, wsum: extended;
  788.  
  789.         procedure SmoothHistogram;
  790.             var
  791.                 i: integer;
  792.         begin
  793.             h2 := h;
  794.             h[0] := (3 * h2[0] + h2[1]) div 5;
  795.             for i := 1 to 254 do
  796.                 h[i] := (h2[i - 1] + 2 * h2[i] + h2[i + 1]) div 4;
  797.         end;
  798.  
  799.     begin
  800.         with results do begin
  801.                 MinLevel := MinIndex;
  802.                 MaxLevel := round(UncalibratedMean);
  803.                 if MaxLevel > 254 then
  804.                     MaxLevel := 254;
  805.                 h := histogram;
  806.                 for i := 0 to 255 do
  807.                     h[i] := h[i] * 10;
  808.                 for i := 1 to 15 do
  809.                     SmoothHistogram;
  810.                 if OptionKeyDown then
  811.                     histogram := h;
  812.                 Background := 0.0;
  813.                 MaxCount := 0;
  814.                 for i := MinLevel to MaxLevel do
  815.                     if h[i] > MaxCount then begin
  816.                             MaxCount := h[i];
  817.                             Background := cvalue[i]
  818.                         end;
  819.                 IntDen := mArea^[mCount] * (mean^[mCount] - Background);
  820.             end;
  821.     end;
  822.  
  823.     procedure ShowValues;
  824.         var
  825.             vloc, hloc: integer;
  826.             tPort: GrafPtr;
  827.             trect: rect;
  828.             clength, cx, cy, IntDen, BackgroundLevel: extended;
  829.             tUnit: UnitType;
  830.  
  831.         procedure NewLine;
  832.         begin
  833.             vloc := vloc + 12;
  834.             MoveTo(hloc, vloc);
  835.         end;
  836.  
  837.     begin
  838.         GetPort(tPort);
  839.         vloc := 35;
  840.         hloc := 4;
  841.         SetPort(ValuesWindow);
  842.         TextFont(ApplFont);
  843.         TextSize(9);
  844.         Setrect(trect, 0, vloc, rwidth, rheight);
  845.         EraseRect(trect);
  846.         if ValuesMessage <> '' then begin
  847.                 Setrect(trect, hloc, vloc + 15, rwidth - 10, rheight);
  848.                 TextBox(pointer(ord(@ValuesMessage) + 1), length(ValuesMessage), trect, teJustLeft)
  849.             end
  850.         else
  851.             with results do begin
  852.                     NewLine;
  853.                     with info^ do begin
  854.                             if ShowCount then begin
  855.                                     DrawBString('Count: ');
  856.                                     DrawLong(mCount);
  857.                                     NewLine;
  858.                                 end;
  859.                             if SpatiallyCalibrated then begin
  860.                                     DrawBString('Pixels: ');
  861.                                     DrawLong(PixelCount^[mCount]);
  862.                                     NewLine;
  863.                                     DrawBString('Area: ');
  864.                                     DrawReal(mArea^[mCount], 1, precision);
  865.                                     DrawString(' square ');
  866.                                     tUnit := xUnit;
  867.                                     if tUnit = 'inch' then
  868.                                         tUnit := 'Inches'
  869.                                     else if tUnit = 'meter' then
  870.                                         tUnit := 'meters'
  871.                                     else if tUnit = 'mile' then
  872.                                         tUnit := 'miles';
  873.                                     DrawString(tUnit);
  874.                                 end
  875.                             else begin
  876.                                     DrawBString('Area: ');
  877.                                     DrawLong(PixelCount^[mCount]);
  878.                                     DrawString(' square pixels');
  879.                                 end;
  880.                             NewLine;
  881.                             DrawBString('Mean: ');
  882.                             DrawReal(mean^[mCount], 1, precision);
  883.                             if DensityCalibrated then begin
  884.                                     DrawString(' ');
  885.                                     DrawBString(UnitOfMeasure);
  886.                                     DrawString('   (');
  887.                                     DrawLong(round(results.UncalibratedMean));
  888.                                     DrawString(')');
  889.                                 end;
  890.                             if PixelCount^[mCount] > 1 then begin
  891.                                     NewLine;
  892.                                     DrawBString('Std Dev: ');
  893.                                     DrawReal(sd^[mCount], 1, precision);
  894.                                     NewLine;
  895.                                     DrawBString('Min: ');
  896.                                     DrawReal(mMin^[mCount], 1, precision);
  897.                                     NewLine;
  898.                                     DrawBString('Max: ');
  899.                                     DrawReal(mMax^[mCount], 1, precision);
  900.                                 end;
  901.                             if (xyLocM in measurements) or (nPoints > 0) then begin
  902.                                     NewLine;
  903.                                     DrawBString('X: ');
  904.                                     DrawReal(xcenter^[mCount], 6, precision);
  905.                                     NewLine;
  906.                                     DrawBString('Y: ');
  907.                                     DrawReal(ycenter^[mCount], 6, precision);
  908.                                 end;
  909.                             if ModeM in Measurements then begin
  910.                                     NewLine;
  911.                                     DrawBString('Mode: ');
  912.                                     DrawReal(mode^[mCount], 1, precision);
  913.                                 end;
  914.                             if (LengthM in measurements) or (nLengths > 0) then begin
  915.                                     NewLine;
  916.                                     DrawBString('Length: ');
  917.                                     DrawReal(plength^[mCount], 1, precision);
  918.                                 end;
  919.                             if MajorAxisM in Measurements then begin
  920.                                     NewLine;
  921.                                     DrawBString(Concat(MajorLabel, ': '));
  922.                                     DrawReal(MajorAxis^[mCount], 1, precision);
  923.                                 end;
  924.                             if MinorAxisM in Measurements then begin
  925.                                     NewLine;
  926.                                     DrawBString(Concat(MinorLabel, ': '));
  927.                                     DrawReal(MinorAxis^[mCount], 1, precision);
  928.                                 end;
  929.                             if (AngleM in measurements) or (nAngles > 0) then begin
  930.                                     NewLine;
  931.                                     DrawBString('Angle: ');
  932.                                     DrawReal(orientation^[mCount], 1, precision);
  933.                                 end;
  934.                             if IntDenM in measurements then begin
  935.                                     NewLine;
  936.                                     FindIntegratedDensity(IntDen, BackgroundLevel);
  937.                                     DrawBString('Integrated Density: ');
  938.                                     DrawReal(IntDen, 1, precision);
  939.                                     NewLine;
  940.                                     DrawBString('Background Level: ');
  941.                                     DrawReal(BackGroundLevel, 1, precision);
  942.                                 end
  943.                             else begin
  944.                                     IntDen := 0.0;
  945.                                     BackGroundLevel := 0.0;
  946.                                 end;
  947.                             IntegratedDensity^[mCount] := IntDen;
  948.                             idBackground^[mCount] := BackGroundLevel;
  949.                             if User1M in Measurements then begin
  950.                                     NewLine;
  951.                                     DrawBString(Concat(User1Label, ': '));
  952.                                     DrawReal(User1^[mCount], 1, precision);
  953.                                 end;
  954.                             if User2M in Measurements then begin
  955.                                     NewLine;
  956.                                     DrawBString(Concat(User2Label, ': '));
  957.                                     DrawReal(User2^[mCount], 1, precision);
  958.                                 end;
  959.                         end;
  960.                 end; {with}
  961.         SetPort(tPort);
  962.         mCount2 := mCount;
  963.     end;
  964.  
  965.  
  966.     procedure PaintCircle (hloc, vloc: integer);
  967.         var
  968.             r: rect;
  969.     begin
  970.         SetRect(r, hloc, vloc, hloc + LineWidth, vloc + LineWidth);
  971.         PaintOval(r);
  972.     end;
  973.  
  974.  
  975.     procedure DrawBrush (start, finish: point);
  976.   {Thanks to Robert Rimmer for suggesting the use of a line generator to implement the brush.}
  977.         var
  978.             deltax, deltay, xinc, yinc, accumulator, i: integer;
  979.             xloc, yloc, offset, j: integer;
  980.     begin
  981.         xloc := start.h;
  982.         yloc := start.v;
  983.         deltax := finish.h - xloc;
  984.         deltay := finish.v - yloc;
  985.         if (deltax = 0) and (deltay = 0) then begin
  986.                 PaintCircle(xloc, yloc);
  987.                 exit(DrawBrush)
  988.             end;
  989.         if deltax < 0 then begin
  990.                 xinc := -1;
  991.                 deltax := -deltax
  992.             end
  993.         else
  994.             xinc := 1;
  995.         if deltay < 0 then begin
  996.                 yinc := -1;
  997.                 deltay := -deltay
  998.             end
  999.         else
  1000.             yinc := 1;
  1001.         if DeltaX > DeltaY then begin {More horizontal}
  1002.                 accumulator := deltax div 2;
  1003.                 i := deltax;
  1004.                 repeat
  1005.                     accumulator := accumulator + deltay;
  1006.                     if accumulator >= deltax then begin
  1007.                             accumulator := accumulator - deltax;
  1008.                             yloc := yloc + yinc
  1009.                         end;
  1010.                     xloc := xloc + xinc;
  1011.                     PaintCircle(xloc, yloc);
  1012.                     i := i - 1;
  1013.                 until i = 0
  1014.             end
  1015.         else begin          {More vertical}
  1016.                 accumulator := deltay div 2;
  1017.                 i := deltay;
  1018.                 repeat
  1019.                     accumulator := accumulator + deltax;
  1020.                     if accumulator >= deltay then begin
  1021.                             accumulator := accumulator - deltay;
  1022.                             xloc := xloc + xinc
  1023.                         end;
  1024.                     yloc := yloc + yinc;
  1025.                     PaintCircle(xloc, yloc);
  1026.                     i := i - 1;
  1027.                 until i = 0
  1028.             end;
  1029.     end;
  1030.  
  1031.  
  1032.     procedure DrawObject;{ (obj: ObjectType; p1, p2: point)}
  1033.         var
  1034.             MaskRect, r, dstRect, osMaskRect: rect;
  1035.             tPort: GrafPtr;
  1036.             tmp: integer;
  1037.     begin
  1038.         GetPort(tPort);
  1039.         Pt2Rect(p1, p2, MaskRect);
  1040.         with Info^ do begin
  1041.                 changes := true;
  1042.                 tmp := trunc(magnification + 0.5) * LineWidth;
  1043.                 with MaskRect do begin
  1044.                         if tmp < 32 then
  1045.                             tmp := 32;
  1046.                         right := right + tmp;
  1047.                         bottom := bottom + tmp;
  1048.                         if magnification > 1.0 then begin
  1049.                                 left := left - tmp;
  1050.                                 top := top - tmp;
  1051.                             end;
  1052.                     end;
  1053.                 ScreenToOffscreen(p1);
  1054.                 ScreenToOffscreen(p2);
  1055.                 SetPort(GrafPtr(osPort));
  1056.                 pmForeColor(ForegroundIndex);
  1057.                 PenNormal;
  1058.                 PenSize(LineWidth, LineWidth);
  1059.                 case obj of
  1060.                     lineObj:  begin
  1061.                             MoveTo(p1.h, p1.v);
  1062.                             LineTo(p2.h, p2.v);
  1063.                         end;
  1064.                     Rectangle:  begin
  1065.                             Pt2Rect(p1, p2, r);
  1066.                             FrameRect(r);
  1067.                         end;
  1068.                     oval:  begin
  1069.                             Pt2Rect(p1, p2, r);
  1070.                             FrameOval(r);
  1071.                         end;
  1072.                     BrushObj: 
  1073.                         DrawBrush(p1, p2);
  1074.                 end;
  1075.                 SetPort(wptr);
  1076.                 pmForeColor(BlackIndex);
  1077.                 pmBackColor(WhiteIndex);
  1078.                 RectRgn(MaskRgn, MaskRect);
  1079.                 hlock(handle(osPort^.portPixMap));
  1080.                 hlock(handle(CGrafPort(wptr^).PortPixMap));
  1081.                 CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(wptr^).PortPixMap)^^, SrcRect, wrect, SrcCopy, MaskRgn);
  1082.                 hunlock(handle(osPort^.portPixMap));
  1083.                 hunlock(handle(CGrafPort(wptr^).PortPixMap));
  1084.                 SetPort(tPort);
  1085.             end; {with}
  1086.     end;
  1087.  
  1088.  
  1089.     function InvertingCalibrationFunction: boolean;
  1090.     begin
  1091.         with info^ do begin
  1092.                 InvertingCalibrationFunction := DensityCalibrated and (fit = StraightLine) and (Coefficient[2] < 0.0)
  1093.             end;
  1094.     end;
  1095.  
  1096.  
  1097.     procedure DrawHistogram;
  1098.         var
  1099.             tPort: GrafPtr;
  1100.             i, h: integer;
  1101.             MaxCount, count, NextMaxCount: LongInt;
  1102.             str: str255;
  1103.             hscale: extended;
  1104.             ShowSlice: boolean;
  1105.     begin
  1106.         ShowSlice := (HistogramSliceStart > 0) or (HistogramSliceEnd < 255);
  1107.         if not printing then begin
  1108.                 GetPort(tPort);
  1109.                 SetPort(HistoWindow);
  1110.                 EraseRect(HistoWindow^.portRect);
  1111.             end;
  1112.         with Results do begin
  1113.                 MaxCount := histogram[imode];
  1114.                 if MaxCount > (hheight - 2) then begin
  1115.                         if MaxCount / PixelCount^[mCount] > 0.08 then begin
  1116.                                 NextMaxCount := 0;
  1117.                                 for i := 0 to 255 do begin
  1118.                                         count := histogram[i];
  1119.                                         if (i <> imode) and (count > NextMaxCount) then
  1120.                                             NextMaxCount := count;
  1121.                                     end;
  1122.                                 NextMaxCount := NextMaxCount + NextMaxCount div 2;
  1123.                                 if (NextMaxCount > MaxCount) or (NextMaxCount = 0) then
  1124.                                     NextMaxCount := MaxCount;
  1125.                                 hscale := NextMaxCount / (hheight - 2);
  1126.                             end
  1127.                         else
  1128.                             hscale := MaxCount / (hheight - 2);
  1129.                     end
  1130.                 else
  1131.                     hscale := 1.0;
  1132.                 if ShowSlice then
  1133.                     PenPat(gray);
  1134.                 if InvertingCalibrationFunction then
  1135.                     for h := 0 to 255 do begin
  1136.                             if h = HistogramSliceStart then
  1137.                                 PenPat(black);
  1138.                             MoveTo(255 - h, hheight);
  1139.                             LineTo(255 - h, hheight - round(histogram[h] / hscale));
  1140.                             if h = HistogramSliceEnd then
  1141.                                 PenPat(gray)
  1142.                         end
  1143.                 else
  1144.                     for h := 0 to 255 do begin
  1145.                             if h = HistogramSliceStart then
  1146.                                 PenPat(black);
  1147.                             MoveTo(h, hheight);
  1148.                             LineTo(h, hheight - round(histogram[h] / hscale));
  1149.                             if h = HistogramSliceEnd then
  1150.                                 PenPat(gray)
  1151.                         end;
  1152.             end;
  1153.         if ShowSlice then
  1154.             PenNormal;
  1155.         if not Printing then
  1156.             SetPort(tPort);
  1157.     end;
  1158.  
  1159.  
  1160.     procedure DrawLabels (xL, yL, zL: str255);
  1161.    {Draws the labels(e.g.,  X:, Y:, Value:) used for the dynamically}
  1162.    {changing values displayed at the top of the Values window.}
  1163.         var
  1164.             tPort: GrafPtr;
  1165.             trect: rect;
  1166.     begin
  1167.         if xL = XLabel then
  1168.             if yL = yLabel then
  1169.                 if zL = zLabel then
  1170.                     exit(DrawLabels);
  1171.         GetPort(tPort);
  1172.         SetPort(ValuesWindow);
  1173.         TextSize(9);
  1174.         TextFont(Monaco);
  1175.         TextFace([bold]);
  1176.         if length(xL) > 0 then begin
  1177.                 xLabel := xL;
  1178.                 xValueLoc := ValuesHStart + StringWidth(xLabel);
  1179.                 yLabel := yL;
  1180.                 yValueLoc := ValuesHStart + StringWidth(yLabel);
  1181.                 zLabel := zL;
  1182.                 zValueLoc := ValuesHStart + StringWidth(zLabel);
  1183.             end;
  1184.         Setrect(trect, 0, 0, rwidth, 32);
  1185.         EraseRect(trect);
  1186.         MoveTo(ValuesHStart, ValuesVStart);
  1187.         DrawString(xLabel);
  1188.         MoveTo(ValuesHStart, ValuesVStart + 10);
  1189.         DrawString(yLabel);
  1190.         MoveTo(ValuesHStart, ValuesVStart + 19);
  1191.         DrawString(zLabel);
  1192.         TextFace([]);
  1193.         SetPort(tPort);
  1194.     end;
  1195.  
  1196.  
  1197.     procedure ShowNextImage;
  1198.         var
  1199.             n: integer;
  1200.     begin
  1201.         n := info^.PicNum + 1;
  1202.         if n > nPics then
  1203.             n := 1;
  1204.         SelectWindow(PicWindow[n]);
  1205.     end;
  1206.  
  1207.  
  1208.     procedure StackImages;
  1209.         var
  1210.             i, hloc, vloc, wwidth, wheight: integer;
  1211.             offset: boolean;
  1212.     begin
  1213.         hloc := PicLeftBase;
  1214.         vloc := PicTopBase;
  1215.         offset := not OptionKeyDown;
  1216.         for i := nPics downto 1 do begin
  1217.                 Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
  1218.                 if Info^.PictureType <> ScionType then begin
  1219.                         with Info^ do begin
  1220.                                 HideWindow(wptr);
  1221.                                 ScaleToFitWindow := false;
  1222.                                 WindowState := NormalWindow;
  1223.                                 if offset then
  1224.                                     wrect := initwrect
  1225.                                 else begin
  1226.                                         wwidth := PixelsPerLine;
  1227.                                         if (hloc + wwidth) > ScreenWidth then
  1228.                                             wwidth := ScreenWidth - hloc - 5;
  1229.                                         wheight := nlines;
  1230.                                         if (vloc + wheight) > ScreenHeight then
  1231.                                             wheight := ScreenHeight - vloc - 5;
  1232.                                         SetRect(wrect, 0, 0, wwidth, wheight);
  1233.                                     end;
  1234.                                 SrcRect := wrect;
  1235.                                 KillRoi;
  1236.                                 magnification := 1.0;
  1237.                                 if i = nPics then
  1238.                                     DrawMyGrowIcon(wptr);
  1239.                                 SizeWindow(wptr, wrect.right, wrect.bottom, true);
  1240.                                 MoveWindow(wptr, hloc, vloc, true);
  1241.                                 ShowWindow(wptr);
  1242.                                 UpdateTitleBar;
  1243.                             end;
  1244.                         if offset then begin
  1245.                                 hloc := hloc + hPicOffset;
  1246.                                 vloc := vloc + vPicOffset;
  1247.                                 if (vloc + 40) > ScreenHeight then
  1248.                                     vloc := PicTopBase;
  1249.                             end;
  1250.                     end;
  1251.             end;
  1252.         PicLeft := PicLeftBase;
  1253.         PicTop := PicTopBase;
  1254.         WhatToUndo := NothingToUndo;
  1255.     end;
  1256.  
  1257.  
  1258.     procedure TileImages;
  1259.         const
  1260.             gap = 2;
  1261.             TitleBarHeight = 20;
  1262.         var
  1263.             i, hloc, vloc, width, height, hspace, vspace, nRows, nColumns: integer;
  1264.             MinWidth, MinHeight: integer;
  1265.             tInfo: array[1..MaxPics] of InfoPtr;
  1266.             trect: rect;
  1267.             TheyFit: boolean;
  1268.     begin
  1269.         PicLeft := PicLeftBase;
  1270.         PicTop := PicTopBase;
  1271.         width := MaxInt;
  1272.         height := MaxInt;
  1273.         for i := 1 to nPics do begin
  1274.                 tInfo[i] := pointer(WindowPeek(PicWindow[i])^.RefCon);
  1275.                 with tinfo[i]^.PicRect do begin
  1276.                         if right < width then
  1277.                             width := right;
  1278.                         if bottom < height then
  1279.                             height := bottom;
  1280.                     end;
  1281.             end;
  1282.         MinWidth := width;
  1283.         MinHeight := height;
  1284.         hspace := ScreenWidth - PicLeft - 2 * gap;
  1285.         if width > hspace then
  1286.             width := hspace;
  1287.         vspace := ScreenHeight - PicTop - TitleBarHeight;
  1288.         if height > vspace then
  1289.             height := vspace;
  1290.         repeat
  1291.             hloc := PicLeft;
  1292.             vloc := PicTop;
  1293.             TheyFit := true;
  1294.             i := 0;
  1295.             repeat
  1296.                 i := i + 1;
  1297.                 if (hloc + width) > ScreenWidth then begin
  1298.                         hloc := PicLeft;
  1299.                         vloc := vloc + TitleBarHeight + height;
  1300.                         if (vloc + height) > ScreenHeight then begin
  1301.                                 TheyFit := false;
  1302.                             end;
  1303.                     end;
  1304.                 hloc := hloc + width + gap;
  1305.             until (TheyFit = false) or (i = nPics);
  1306.             if TheyFit = false then begin
  1307.                     width := round(width * 0.98);
  1308.                     height := round(height * 0.98);
  1309.                 end;
  1310.         until TheyFit;
  1311.         nColumns := (ScreenWidth - PicLeft) div (width + gap);
  1312.         nRows := nPics div nColumns;
  1313.         if (nPics mod nColumns) <> 0 then
  1314.             nRows := nRows + 1;
  1315. {ShowMessage(concat('nRows= ', Long2str(nRows), cr, 'nColumns= ', long2str(nColumns)));}
  1316.         if not OptionKeyWasDown then begin
  1317.                 width := round((ScreenWidth - PicLeft) / nColumns);
  1318.                 width := width - gap - 1;
  1319.                 height := round((ScreenHeight - PicTop) / nRows);
  1320.                 height := height - TitleBarHeight + 3;
  1321.                 if width > MinWidth then
  1322.                     width := MinWidth;
  1323.                 if height > MinHeight then
  1324.                     height := MinHeight;
  1325.             end;
  1326.         hloc := PicLeft;
  1327.         vloc := PicTop;
  1328.         for i := 1 to nPics do begin
  1329.                 if (hloc + width) > ScreenWidth then begin
  1330.                         hloc := PicLeft;
  1331.                         vloc := vloc + TitleBarHeight + height;
  1332.                     end;
  1333.                 Info := tInfo[i];
  1334.                 if Info^.PictureType <> ScionType then begin
  1335.                         with Info^ do begin
  1336.                                 SetRect(wrect, 0, 0, width, height);
  1337.                                 if ScaleToFitWindow then begin
  1338.                                         ScaleToFitWindow := false;
  1339.                                         SrcRect := wrect;
  1340.                                         magnification := 1;
  1341.                                         WindowState := NormalWindow;
  1342.                                     end;
  1343.                                 if OptionKeyWasDown then begin
  1344.                                         ScaleToFitWindow := true;
  1345.                                         SrcRect := PicRect;
  1346.                                         ScaleImageWindow(wrect);
  1347.                                         WindowState := TiledSmallScaled;
  1348.                                     end
  1349.                                 else begin
  1350.                                         SrcRect := wrect;
  1351.                                         magnification := 1.0;
  1352.                                         UpdateTitleBar;
  1353.                                         WindowState := TiledSmall;
  1354.                                     end;
  1355.                                 SizeWindow(wptr, wrect.right, wrect.bottom, true);
  1356.                                 KillRoi;
  1357.                                 UpdatePicWindow;
  1358.                             end;
  1359.                         MoveWindow(PicWindow[i], hloc, vloc, true);
  1360.                         hloc := hloc + width + gap;
  1361.                     end;
  1362.             end;        {for}
  1363.         WhatToUndo := NothingToUndo;
  1364.     end;
  1365.  
  1366.  
  1367.     function Duplicate (name: str255; SavingBlankField: boolean): boolean;
  1368.         var
  1369.             width, height, hstart, vstart, i: integer;
  1370.             SaveInfo: InfoPtr;
  1371.             src, dst: ptr;
  1372.             offset: LongInt;
  1373.             AutoSelectAll: boolean;
  1374.     begin
  1375.         Duplicate := false;
  1376.         if nPics = MaxPics then
  1377.             exit(Duplicate);
  1378.         WhatToUndo := NothingToUndo;
  1379.         if (not SavingBlankField) and (NotRectangular or NotinBounds) then
  1380.             exit(Duplicate);
  1381.         AutoSelectAll := (not Info^.RoiShowing) or SavingBlankField;
  1382.         if AutoSelectAll then
  1383.             SelectAll(false);
  1384.         ShowWatch;
  1385.         with info^ do begin
  1386.                 if name = '' then begin
  1387.                         name := concat('Copy of ', title);
  1388.                         if length(name) > 32 then
  1389.                             delete(name, 33, length(name) - 32);
  1390.                     end;
  1391.                 with RoiRect do begin
  1392.                         width := right - left;
  1393.                         if odd(width) then begin
  1394.                                 if (left + width < PicRect.right) then
  1395.                                     width := Width + 1
  1396.                                 else
  1397.                                     Width := width - 1;
  1398.                             end;
  1399.                         height := bottom - top;
  1400.                         hstart := left;
  1401.                         vstart := top;
  1402.                     end;
  1403.             end;
  1404.         if AutoSelectAll then
  1405.             KillRoi;
  1406.         SaveInfo := Info;
  1407.         if NewPicWindow(name, width, height) then
  1408.             with SaveInfo^ do begin
  1409.                     offset := LongInt(vstart) * BytesPerRow + hstart;
  1410.                     src := ptr(ord4(PicBaseAddr) + offset);
  1411.                     dst := Info^.PicBaseAddr;
  1412.                     for i := 0 to height - 1 do begin
  1413.                             BlockMove(src, dst, width);
  1414.                             src := ptr(ord4(src) + BytesPerRow);
  1415.                             dst := ptr(ord4(dst) + width);
  1416.                         end;
  1417.                     if SavingBlankField then begin
  1418.                             Info^.PIctureType := BlankField;
  1419.                             BlankFieldInfo := info;
  1420.                         end;
  1421.                     Duplicate := true;
  1422.                 end; {with}
  1423.     end;
  1424.  
  1425.  
  1426.     procedure InvertPic;
  1427.         var
  1428.             tPort: GrafPtr;
  1429.     begin
  1430.         GetPort(tPort);
  1431.         with Info^ do begin
  1432.                 SetPort(GrafPtr(osPort));
  1433.                 InvertRect(PicRect);
  1434.             end;
  1435.         SetPort(tPort);
  1436.     end;
  1437.  
  1438.  
  1439.     procedure ShowMessage (str: str255);
  1440.     begin
  1441.         ValuesMessage := str;
  1442.         ShowValues;
  1443.     end;
  1444.  
  1445.  
  1446.     procedure ShowTime (StartTicks: LongInt; r: rect; str: str255);
  1447.         var
  1448.             nPixels: LongInt;
  1449.             str1, str2, str3: str255;
  1450.             seconds, rate: extended;
  1451.     begin
  1452.         with r do
  1453.             nPixels := LongInt(right - left) * (bottom - top);
  1454.         NumToString(nPixels, str1);
  1455.         seconds := (TickCount - StartTicks) / 60.0;
  1456.         RealToString(seconds, 1, 2, str2);
  1457.         if seconds <> 0.0 then
  1458.             rate := nPixels / seconds
  1459.         else
  1460.             rate := 0.0;
  1461.         NumToString(round(rate), str3);
  1462.         ShowMessage(concat(str1, ' pixels ', cr, str2, ' seconds', cr, str3, ' pixels/second', cr, str));
  1463.     end;
  1464.  
  1465.     procedure ShowFrameRate (str1: str255; StartTicks, nFrames: LongInt);
  1466.         var
  1467.             seconds: extended;
  1468.             str2: str255;
  1469.     begin
  1470.         seconds := (TickCount - StartTicks) / 60.0;
  1471.         if seconds = 0.0 then
  1472.             seconds := 0.167;
  1473.         RealToString(nFrames / seconds, 1, 2, str2);
  1474.         ShowMessage(concat(str1, str2, ' frames/second'));
  1475.     end;
  1476.  
  1477.  
  1478.     procedure ConvertHistoToText;
  1479.         var
  1480.             i: integer;
  1481.             ValuesInverted: boolean;
  1482.     begin
  1483.         ValuesInverted := InvertingCalibrationFunction;
  1484.         TextBufSize := 0;
  1485.         for i := 0 to 255 do begin
  1486.                 if ValuesInverted then
  1487.                     PutLong(Histogram[255 - i], 1)
  1488.                 else
  1489.                     PutLong(Histogram[i], 1);
  1490.                 if i <> 255 then
  1491.                     PutChar(cr);
  1492.             end;
  1493.     end;
  1494.  
  1495.  
  1496.     procedure ConvertPlotToText;
  1497.         var
  1498.             i: integer;
  1499.     begin
  1500.         TextBufSize := 0;
  1501.         for i := 0 to PlotCount - 1 do begin
  1502.                 PutReal(PlotData^[i], 1, precision);
  1503.                 if i <> PlotCount then
  1504.                     PutChar(cr);
  1505.             end;
  1506.     end;
  1507.  
  1508.  
  1509.     procedure ConvertCalibrationCurveToText;
  1510.         var
  1511.             i: integer;
  1512.     begin
  1513.         TextBufSize := 0;
  1514.         for i := 0 to 255 do begin
  1515.                 PutReal(cvalue[i], 1, 3);
  1516.                 if i <> 255 then
  1517.                     PutChar(cr);
  1518.             end;
  1519.     end;
  1520.  
  1521.  
  1522.     procedure SetupUndoInfoRec;
  1523. {Initialize the Undo buffer's Info record so we can copy}
  1524. {the current image to the Undo buffer and operate on it.}
  1525.     begin
  1526.         with UndoInfo^ do begin
  1527.                 PixelsPerLine := info^.PixelsPerLine;
  1528.                 BytesPerRow := info^.BytesPerRow;
  1529.                 nLines := Info^.nLines;
  1530.                 ImageSize := Info^.ImageSize;
  1531.                 PixMapSize := info^.PixMapSize;
  1532.                 RoiRect := info^.RoiRect;
  1533.                 CopyRgn(Info^.roiRgn, roiRgn);
  1534.                 roiType := Info^.roiType;
  1535.                 PicRect := Info^.PicRect;
  1536.                 with osPort^ do begin
  1537.                         with portPixMap^^ do begin
  1538.                                 RowBytes := BitOr(BytesPerRow, $8000);
  1539.                                 bounds := PicRect;
  1540.                             end;
  1541.                         PortRect := PicRect;
  1542.                         RectRgn(visRgn, PicRect);
  1543.                     end;
  1544.             end;
  1545.     end;
  1546.  
  1547.  
  1548.     function GetScaleAndAngle: boolean;
  1549.         const
  1550.             hScaleID = 7;
  1551.             vScaleID = 8;
  1552.             AngleID = 9;
  1553.             NearestNeighborID = 10;
  1554.             BilinearID = 11;
  1555.             NewWindowID = 12;
  1556.         var
  1557.             mylog: DialogPtr;
  1558.             item, i: integer;
  1559.             vScaleUnchanged: boolean;
  1560.             str: str255;
  1561.     begin
  1562.         vScaleUnchanged := true;
  1563.         InitCursor;
  1564.         mylog := GetNewDialog(50, nil, pointer(-1));
  1565.         SetDReal(MyLog, AngleID, rsAngle, 2);
  1566.         SetDReal(MyLog, hScaleID, rsHScale, 2);
  1567.         SelIText(MyLog, hScaleID, 0, 32767);
  1568.         SetDReal(MyLog, vScaleID, rsVScale, 2);
  1569.         SetDialogItem(mylog, NewWindowID, ord(rsCreateNewWindow));
  1570.         SetDialogItem(mylog, BilinearID, ord(rsMethod = Bilinear));
  1571.         SetDialogItem(mylog, NearestNeighborID, ord(rsMethod = NearestNeighbor));
  1572.         repeat
  1573.             ModalDialog(nil, item);
  1574.             if item = AngleID then begin
  1575.                     rsAngle := GetDREal(MyLog, AngleID);
  1576.                     if rsAngle > 180.0 then
  1577.                         rsAngle := 180.0;
  1578.                     if rsAngle < -180.0 then
  1579.                         rsAngle := -180.0;
  1580.                 end;
  1581.             if item = hScaleID then begin
  1582.                     str := GetDString(MyLog, hScaleID);
  1583.                     rsHScale := StringToReal(str);
  1584.                     if rsHScale = BadReal then
  1585.                         rsHScale := 1.0;
  1586.                     if vScaleUnchanged then begin
  1587.                             rsVScale := rsHScale;
  1588.                             SetDString(MyLog, vScaleID, str);
  1589.                         end;
  1590.                     if rsHScale < 0.05 then
  1591.                         rsHScale := 0.05;
  1592.                 end;
  1593.             if item = vScaleID then begin
  1594.                     rsVScale := GetDReal(MyLog, vScaleID);
  1595.                     if rsVScale = BadReal then
  1596.                         rsVScale := 1.0;
  1597.                     if rsVScale < 0.05 then
  1598.                         rsVScale := 0.05;
  1599.                     vScaleUnchanged := false;
  1600.                 end;
  1601.             if item = NewWindowID then begin
  1602.                     rsCreateNewWindow := not rsCreateNewWindow;
  1603.                     SetDialogItem(mylog, NewWindowID, ord(rsCreateNewWindow));
  1604.                 end;
  1605.             if (item = BilinearID) or (item = NearestNeighborID) then begin
  1606.                     if item = BilinearID then
  1607.                         rsMethod := Bilinear;
  1608.                     if item = NearestNeighborID then
  1609.                         rsMethod := NearestNeighbor;
  1610.                     SetDialogItem(mylog, BilinearID, ord(rsMethod = Bilinear));
  1611.                     SetDialogItem(mylog, NearestNeighborID, ord(rsMethod = NearestNeighbor));
  1612.                 end;
  1613.         until (item = ok) or (item = cancel);
  1614.         DisposDialog(mylog);
  1615.         GetScaleAndAngle := item <> cancel;
  1616.     end;
  1617.  
  1618.  
  1619.     procedure ScaleAndRotate;
  1620.         const
  1621.             pi = 3.14159;
  1622.         type
  1623.             EraseType = (Erase, DontErase);
  1624.         var
  1625.             CosAngle, SinAngle, htemp, vtemp, h, v: extended;
  1626.             hloc, vloc, value, DstWidth, DstHeight, hstart, vstart, hend, vend: integer;
  1627.             hfraction, vfraction, UpperAverage, LowerAverage, AngleInRadians: extended;
  1628.             LowerLeft, LowerRight, UpperLeft, UpperRight, SaveWidth, SaveHeight: integer;
  1629.             hSrcCenter, vSrcCenter, hDstCenter, vDstCenter: integer;
  1630.             hRel, vRel, hbase, vbase, SrcWidth, SrcHeight: integer;
  1631.             SrcInfo, DstInfo, SaveInfo: InfoPtr;
  1632.             AutoSelectAll, UseNearestNeighbor, Rotate: boolean;
  1633.             MaskRect, SourceRect, DstRect: rect;
  1634.             StartTicks: LongInt;
  1635.             UseSameWindow: boolean;
  1636.  
  1637.         procedure DoInterpolatedScaling;
  1638.     {Does interpolated scaling, but no rotation, using scaled integer arithmetic.}
  1639.             const
  1640.                 CountsPerUpdate = 5;
  1641.             var
  1642.                 SrcLeft, hloc, vloc, vbase, hbase, hrel: integer;
  1643.                 LineCount, oldvloc, LastLine: integer;
  1644.                 DstLine, SrcLine1, SrcLine2: LineType;
  1645.                 MaskRect: rect;
  1646.                 v, SrcTop: extended;
  1647.                 h, hFraction, vFraction, UpperAverage, LowerAverage: LongInt;
  1648.                 scale, scale2, hscale: LongInt;
  1649.         begin
  1650.             scale := 1000;
  1651.             scale2 := scale * scale;
  1652.             hscale := round(rsHScale * scale);
  1653.             if SrcWidth >= MaxLine then
  1654.                 exit(DoInterpolatedScaling);
  1655.             LastLine := SrcInfo^.PicRect.bottom - 1;
  1656.             with SourceRect do begin
  1657.                     SrcLeft := left;
  1658.                     SrcTop := top;
  1659.                 end;
  1660.             with DstRect do begin
  1661.                     oldvloc := top;
  1662.                     LineCount := 0;
  1663.                     for vloc := top to bottom - 1 do begin
  1664.                             v := SrcTop + (vloc - top) / rsVScale;
  1665.                             vbase := trunc(v);
  1666.                             vFraction := round((v - vbase) * scale);
  1667.                             Info := SrcInfo;
  1668.                             GetLine(SrcLeft, vbase, SrcWidth, SrcLine1);
  1669.                             SrcLine1[SrcWidth] := SrcLine1[SrcWidth - 1];
  1670.                             if vbase <> LastLine then begin
  1671.                                     GetLine(SrcLeft, vbase + 1, SrcWidth, SrcLine2);
  1672.                                     SrcLine2[SrcWidth] := SrcLine2[SrcWidth - 1];
  1673.                                 end;
  1674.                             for hloc := left to right - 1 do begin
  1675.                                     hrel := hloc - left;
  1676.                                     h := hrel * scale2 div hscale;
  1677.                                     hbase := hrel * scale div hscale;
  1678.                                     hFraction := h mod scale;
  1679.                                     LowerAverage := SrcLine1[hbase] + hFraction * (SrcLine1[hbase + 1] - SrcLine1[hbase]) div scale;
  1680.                                     UpperAverage := SrcLine2[hbase] + hFraction * (SrcLine2[hbase + 1] - SrcLine2[hbase]) div scale;
  1681.                                     DstLine[hrel] := (LowerAverage + vfraction * (UpperAverage - LowerAverage) div scale);
  1682.                                 end;
  1683.                             Info := DstInfo;
  1684.                             PutLine(left, vloc, DstWidth, DstLine);
  1685.                             LineCount := LineCount + 1;
  1686.                             if LineCount >= CountsPerUpdate then begin
  1687.                                     LineCount := 0;
  1688.                                     SetRect(MaskRect, left, oldvloc, right, vloc + 1);
  1689.                                     UpdateScreen(MaskRect);
  1690.                                     oldvloc := vloc;
  1691.                                 end;
  1692.                             if CommandPeriod then begin
  1693.                                     beep;
  1694.                                     exit(DoInterpolatedScaling)
  1695.                                 end;
  1696.                         end; {for vloc:=}
  1697.                     SetRect(MaskRect, left, oldvloc, right, vloc + 1);
  1698.                     UpdateScreen(MaskRect);
  1699.                 end;
  1700.         end;
  1701.  
  1702.         procedure ScaleUsingCopyBits;
  1703.             var
  1704.                 srcPort: cGrafPtr;
  1705.                 SavePort: GrafPtr;
  1706.                 MaskRect: rect;
  1707.         begin
  1708.             with DstInfo^ do begin
  1709.                     GetPort(SavePort);
  1710.                     SetPort(GrafPtr(osPort));
  1711.                     pmForeColor(BlackIndex);
  1712.                     pmBackColor(WhiteIndex);
  1713.                     srcPort := SrcInfo^.osPort;
  1714.                     hlock(handle(srcPort^.portPixMap));
  1715.                     hlock(handle(osPort^.portPixMap));
  1716.                     CopyBits(BitMapHandle(srcPort^.portPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, SourceRect, DstRect, SrcCopy, nil);
  1717.                     hunlock(handle(srcPort^.portPixMap));
  1718.                     hunlock(handle(osPort^.PortPixMap));
  1719.                     pmForeColor(ForegroundIndex);
  1720.                     pmBackColor(BackgroundIndex);
  1721.                     SetPort(SavePort);
  1722.                 end;
  1723.             if UseSameWindow then begin
  1724.                     MaskRect := DstRect;
  1725.                     UpdateScreen(MaskRect);
  1726.                 end;
  1727.         end;
  1728.  
  1729.  
  1730.     begin
  1731.         if NotRectangular or NotInBounds then
  1732.             exit(ScaleAndRotate);
  1733.         if not (macro and not rsInteractive) then
  1734.             if not GetScaleAndAngle then
  1735.                 exit(ScaleAndRotate);
  1736.         UpdatePicWindow;
  1737.         UseSameWindow := not rsCreateNewWindow;
  1738.         if UseSameWindow then
  1739.             with info^ do
  1740.                 if NoUndo then begin
  1741.                         macro := false;
  1742.                         exit(ScaleAndRotate)
  1743.                     end;
  1744.         with info^ do
  1745.             UseNearestNeighbor := rsMethod = NearestNeighbor;
  1746.         DrawTools;
  1747.         AutoSelectAll := not Info^.RoiShowing;
  1748.         if AutoSelectAll then
  1749.             SelectAll(true);
  1750.         ShowWatch;
  1751.         if UseSameWindow then begin
  1752.                 SetupUndo;
  1753.                 WhatToUndo := UndoEdit;
  1754.                 SetupUndoInfoRec;
  1755.                 SrcInfo := UndoInfo;
  1756.                 DstInfo := Info;
  1757.                 if rsAngle = 0.0 then
  1758.                     DoOperation(EraseOp);
  1759.             end
  1760.         else
  1761.             SrcInfo := info;
  1762.         AngleInRadians := -((rsAngle + 270.0) / 360.0) * 2.0 * pi;
  1763.         CosAngle := cos(AngleInRadians);
  1764.         SinAngle := sin(AngleInRadians);
  1765.         with info^ do begin
  1766.                 SourceRect := RoiRect;
  1767.                 DstRect := RoiRect;
  1768.             end;
  1769.         with SourceRect do begin
  1770.                 SrcWidth := right - left;
  1771.                 SrcHeight := bottom - top;
  1772.                 hSrcCenter := left + (SrcWidth div 2);
  1773.                 vSrcCenter := top + (SrcHeight div 2);
  1774.                 DstWidth := SrcWidth;
  1775.                 DstHeight := SrcHeight;
  1776.             end;
  1777.         if UseSameWindow then
  1778.             with DstRect, info^ do begin
  1779.                     if rsHScale <> 1.0 then begin
  1780.                             DstWidth := round(SrcWidth * rsHScale);
  1781.                             SaveWidth := DstWidth;
  1782.                             left := left - (DstWidth - SrcWidth) div 2;
  1783.                             if DstWidth > PicRect.right then
  1784.                                 DstWidth := PicRect.right;
  1785.                             if left < 0 then
  1786.                                 left := 0;
  1787.                             right := left + DstWidth;
  1788.                             if DstWidth <> SaveWidth then begin
  1789.                                     SrcWidth := round(SrcWidth * (DstWidth / SaveWidth));
  1790.                                     SourceRect.left := hSrcCenter - SrcWidth div 2;
  1791.                                     SourceRect.right := SourceRect.left + SrcWidth;
  1792.                                 end;
  1793.                         end;
  1794.                     if rsVScale <> 1.0 then begin
  1795.                             DstHeight := round(SrcHeight * rsVScale);
  1796.                             SaveHeight := DstHeight;
  1797.                             top := top - (DstHeight - SrcHeight) div 2;
  1798.                             if DstHeight > PicRect.bottom then
  1799.                                 DstHeight := PicRect.bottom;
  1800.                             if top < 0 then
  1801.                                 top := 0;
  1802.                             bottom := top + DstHeight;
  1803.                             if DstHeight <> SaveHeight then begin
  1804.                                     SrcHeight := round(SrcHeight * (DstHeight / SaveHeight));
  1805.                                     SourceRect.top := vSrcCenter - SrcHeight div 2;
  1806.                                     SourceRect.bottom := SourceRect.top + SrcHeight;
  1807.                                 end;
  1808.                         end
  1809.                 end {with}
  1810.         else begin
  1811.                 DstWidth := round(SrcWidth * rsHScale);
  1812.                 DstHeight := round(SrcHeight * rsVScale);
  1813.                 if not NewPicWindow('Untitled', DstWidth, DstHeight) then begin
  1814.                         KillRoi;
  1815.                         exit(ScaleAndRotate)
  1816.                     end;
  1817.                 DstInfo := info;
  1818.                 DstRect := info^.PicRect;
  1819.             end;
  1820.         with DstRect do begin
  1821.                 hStart := left;
  1822.                 vStart := top;
  1823.                 hDstCenter := left + (DstWidth div 2);
  1824.                 vDstCenter := top + (DstHeight div 2);
  1825.             end;
  1826.         hend := hstart + DstWidth - 1;
  1827.         vend := vstart + DstHeight - 1;
  1828.         rotate := rsAngle <> 0.0;
  1829.         ShowMessage(CmdPeriodToStop);
  1830.         StartTicks := TickCount;
  1831.         if not rotate and (rsMethod = NearestNeighbor) then
  1832.             ScaleUsingCopyBits
  1833.         else if not rotate and not UseNearestNeighbor then
  1834.             DoInterpolatedScaling
  1835.         else
  1836.             for vloc := vStart to vEnd do begin
  1837.                     for hloc := hStart to hEnd do begin
  1838.                             hrel := hloc - hDstCenter;
  1839.                             vrel := vloc - vDstCenter;
  1840.                             htemp := hrel * SinAngle + vrel * CosAngle;
  1841.                             vtemp := vrel * SinAngle - hrel * CosAngle;
  1842.                             htemp := htemp / rsHScale;
  1843.                             vtemp := vtemp / rsVScale;
  1844.                             h := htemp + hSrcCenter;
  1845.                             v := vtemp + vSrcCenter;
  1846.                             info := SrcInfo;
  1847.                             if UseNearestNeighbor then
  1848.                                 value := MyGetPixel(round(h), round(v))
  1849.                             else begin {Use bilinear interpolation}
  1850.                                     hbase := trunc(h);
  1851.                                     vbase := trunc(v);
  1852.                                     hFraction := h - hbase;
  1853.                                     vFraction := v - vbase;
  1854.                                     LowerLeft := MyGetPixel(hbase, vbase);
  1855.                                     LowerRight := MyGetPixel(hbase + 1, vbase);
  1856.                                     UpperRight := MyGetPixel(hbase + 1, vbase + 1);
  1857.                                     UpperLeft := MyGetPixel(hbase, vbase + 1);
  1858.                                     UpperAverage := UpperLeft + hfraction * (UpperRight - UpperLeft);
  1859.                                     LowerAverage := LowerLeft + hfraction * (LowerRight - LowerLeft);
  1860.                                     value := round(LowerAverage + vfraction * (UpperAverage - LowerAverage));
  1861.                                 end;
  1862.                             Info := DstInfo;
  1863.                             PutPixel(hloc, vloc, value);
  1864.                         end; {for hloc:=}
  1865.                     SetRect(MaskRect, hstart, vloc, hend, vloc + 1);
  1866.                     UpdateScreen(MaskRect);
  1867.                     if CommandPeriod then begin
  1868.                             beep;
  1869.                             KillRoi;
  1870.                             exit(ScaleAndRotate)
  1871.                         end;
  1872.                 end; {for vloc:=}
  1873.         ShowTime(StartTicks, DstRect, '');
  1874.         KillRoi;
  1875.         with info^ do begin
  1876.                 changes := true;
  1877.                 if not UseSameWindow and (PixMapSize > UndoBufSize) then
  1878.                     PutWarning;
  1879.                 if SpatiallyCalibrated and (not UseSameWindow) then begin
  1880.                         xSpatialScale := xSpatialScale * (DstWidth / SrcWidth);
  1881.                         PixelAspectRatio := PixelAspectRatio * rsHScale / rsVScale;
  1882.                         ySpatialScale := xSpatialScale / PixelAspectRatio;
  1883.                     end;
  1884.             end;
  1885.         if not UseSameWindow and AutoSelectAll then begin
  1886.                 SaveInfo := Info;
  1887.                 Info := SrcInfo;
  1888.                 KillRoi;
  1889.                 Info := SaveInfo;
  1890.             end;
  1891.         if UseSameWindow then
  1892.             with NoInfo^ do begin
  1893.                     roiType := RectRoi;
  1894.                     RoiRect := DstRect;
  1895.                     RectRgn(roiRgn, DstRect);
  1896.                 end;
  1897.     end;
  1898.  
  1899.  
  1900. {$POP}
  1901.  
  1902.  
  1903.     procedure ActivateWindow;
  1904.         var
  1905.             tPort: GrafPtr;
  1906.     begin
  1907.         with info^ do begin
  1908.                 IsInsertionPoint := false;
  1909.                 WhatToUndo := NothingToUndo;
  1910.                 UndoFromClip := false;
  1911.                 DrawLabels('', '', '');
  1912.                 MouseState := NotInRoi;
  1913.                 RoiUpdateTime := 0;
  1914.                 if osPort <> nil then begin
  1915.                         GetPort(tPort);
  1916.                         SetPort(GrafPtr(osPort));
  1917.                         pmForeColor(ForegroundIndex);
  1918.                         pmBackColor(BackgroundIndex);
  1919.                         SetPort(tPort);
  1920.                     end;
  1921.                 ShowRoi;
  1922.             end;
  1923.     end;
  1924.  
  1925.  
  1926.     procedure UpdateResultsWindow;
  1927.     begin
  1928.         SetPort(ResultsWindow);
  1929.         DrawControls(ResultsWindow);
  1930.         DrawGrowIcon(ResultsWindow);
  1931.         UpdateList;
  1932.         if ResultsWindow = FrontWindow then begin
  1933.                 ShowControl(hScrollBar);
  1934.                 ShowControl(vScrollBar);
  1935.             end
  1936.         else begin
  1937.                 HideControl(hScrollBar);
  1938.                 HideControl(vScrollBar);
  1939.             end;
  1940.     end;
  1941.  
  1942.  
  1943.     procedure ScrollResultsText;
  1944.         var
  1945.             value: INTEGER;
  1946.     begin
  1947.         with ListTE^^ do
  1948.             TEScroll((viewRect.left - destRect.left) - GetCtlValue(hScrollBar), (viewRect.top - destRect.top) - (GetCtlValue(vScrollBar) * LineHeight), ListTE);
  1949.     end;
  1950.  
  1951.  
  1952.     procedure UpdateResultsScrollBars;
  1953.         var
  1954.             vMax, vValue, hMax, hValue: integer;
  1955.     begin
  1956.         with ListTE^^, ListTE^^.viewRect do begin
  1957.                 vListPageSize := (bottom - top) div LineHeight;
  1958.                 hListPageSize := right - left;
  1959.                 vMax := nLines - vListPageSize;
  1960.                 hMax := (nListColumns + 1) * (FieldWidth + 1) * 6 - hListPageSize;
  1961.                 vValue := (top - destRect.top) div LineHeight;
  1962.                 hValue := left - destRect.left
  1963.             end;
  1964.         if vMax < 0 then
  1965.             vMax := 0;
  1966.         if vValue < 0 then
  1967.             vValue := 0;
  1968.         if hMax < 0 then
  1969.             hMax := 0;
  1970.         if vValue < 0 then
  1971.             vValue := 0;
  1972.         SetCtlMax(vScrollBar, vMax);
  1973.         SetCtlValue(vScrollBar, vValue);
  1974.         SetCtlMax(hScrollBar, hMax);
  1975.         SetCtlValue(hScrollBar, hValue);
  1976. {ShowMessage(concat('nListColumns= ', Long2str(nListColumns), cr, 'hListPageSize= ', long2str(hListPageSize)));}
  1977.     end;
  1978.  
  1979.  
  1980.     procedure InitResultsTextEdit (font, size: integer);
  1981.         var
  1982.             dRect, vRect: rect;
  1983.     begin
  1984.         SetPort(ResultsWindow);
  1985.         with ResultsWindow^.portRect do
  1986.             SetRect(dRect, left + 4, top, right - 18, bottom - 24);
  1987.         vRect := dRect;
  1988.         ListTE := TENew(dRect, vRect);
  1989.         with ListTE^^ do begin
  1990.                 TxFont := font;
  1991.                 TxSize := size;
  1992.                 crOnly := -1;
  1993.             end;
  1994.         if TextBufSize > 0 then begin
  1995.                 TESetText(ptr(TextBufP), TextBufSize, ListTe);
  1996.                 TECalText(ListTE);
  1997.             end;
  1998.         UpdateResultsScrollBars;
  1999.     end;
  2000.  
  2001.  
  2002.     procedure ScrAction (theCtl: ControlHandle; partCode: integer);
  2003.         var
  2004.             bInc, pInc, delta: integer;
  2005.     begin
  2006.         if theCtl = vScrollBar then begin
  2007.                 bInc := 1;
  2008.                 pInc := vListPageSize
  2009.             end
  2010.         else begin
  2011.                 bInc := 4;
  2012.                 pInc := hListPageSize
  2013.             end;
  2014.         case partCode of
  2015.             inUpButton: 
  2016.                 delta := -bInc;
  2017.             inDownButton: 
  2018.                 delta := bInc;
  2019.             inPageUp: 
  2020.                 delta := -pInc;
  2021.             inPageDown: 
  2022.                 delta := pInc;
  2023.             otherwise
  2024.                 exit(ScrAction);
  2025.         end;
  2026.         SetCtlValue(theCtl, GetCtlValue(theCtl) + delta);
  2027.         ScrollResultsText;
  2028.     end;
  2029.  
  2030.  
  2031.     procedure DoMouseDownInResults (loc: point);
  2032.         var
  2033.             theCtl: ControlHandle;
  2034.             cValue: integer;
  2035.     begin
  2036.         SelectWindow(ResultsWindow);
  2037.         SetPort(ResultsWindow);
  2038.         GlobalToLocal(loc);
  2039.         case FindControl(loc, ResultsWindow, theCtl) of
  2040.             inUpButton, inDownButton, inPageUp, inPageDown: 
  2041.                 if TrackControl(theCtl, loc, @ScrAction) <> 0 then
  2042.                     ;
  2043.             inThumb: 
  2044.                 if TrackControl(theCtl, loc, nil) <> 0 then
  2045.                     ScrollResultsText;
  2046.             otherwise
  2047.         end;
  2048.     end;
  2049.  
  2050.  
  2051.     procedure AppendResults;
  2052.         var
  2053.             vMax: integer;
  2054.     begin
  2055.         if ResultsWindow <> nil then
  2056.             with ListTE^^ do begin
  2057.                     if teLength > 32000 then
  2058.                         exit(AppendResults);
  2059.                     CopyResultsToBuffer(mCount, mCount, true);
  2060.                     TESetSelect(teLength, teLength, ListTE);
  2061.                     TEInsert(ptr(TextBufP), TextBufSize, ListTE);
  2062.                     with ListTE^^ do begin
  2063.                             vListPageSize := (viewRect.bottom - viewRect.top) div LineHeight;
  2064.                             vMax := nLines - vListPageSize;
  2065.                         end;
  2066.                     if vMax < 0 then
  2067.                         vMax := 0;
  2068.                     SetCtlMax(vScrollBar, vMax);
  2069.                     SetCtlValue(vScrollBar, GetCtlMax(vScrollBar));
  2070.                     ScrollResultsText;
  2071.                 end;
  2072.     end;
  2073.  
  2074.  
  2075.     procedure DeleteLines (first, last: integer);
  2076.     begin
  2077.         if ResultsWindow <> nil then
  2078.             with ListTE^^ do begin
  2079.                     first := first + 2; {Accounts for 2 line header}
  2080.                     last := last + 2;
  2081.                     if (first = 3) and (last = 3) then
  2082.                         first := 1; {if deleting first line then delete header too}
  2083.                     if (first < 1) or (first > nLines) or (last < 1) or (last > nLines) then
  2084.                         exit(DeleteLines);
  2085.                     TESetSelect(LineStarts[first - 1], LineStarts[last], ListTE);
  2086.                     TEDelete(ListTE);
  2087.                 end;
  2088.     end;
  2089.  
  2090.  
  2091.     procedure UpdateList;
  2092.     begin
  2093.         if (ResultsWindow <> nil) and (mCount > 0) then
  2094.             with ListTE^^ do begin
  2095.                     CopyResultsToBuffer(1, mCount, true);
  2096.                     TESetSelect(0, teLength, ListTE);
  2097.                     TEDelete(ListTE);
  2098.                     TEInsert(ptr(TextBufP), TextBufSize, ListTE);
  2099.                     UpdateResultsScrollBars;
  2100.                 end;
  2101.     end;
  2102.  
  2103.  
  2104.     procedure SelectSlice (i: integer);
  2105.     begin
  2106.         with info^, info^.StackInfo^ do
  2107.             if i <= nSlices then begin
  2108.                     hunlock(PicBaseHandle);
  2109.                     PicBaseHandle := PicBaseH[i];
  2110.                     hlock(PicBaseHandle);
  2111.                     PicBaseAddr := StripAddress(PicBaseHandle^);
  2112.                     osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
  2113.                 end;
  2114.     end;
  2115.  
  2116.  
  2117.     procedure ShowMeter;
  2118.         const
  2119.             MeterWidth = 264;
  2120.             MeterHeight = 64;
  2121.         var
  2122.             trect: rect;
  2123.             hloc, vloc: integer;
  2124.     begin
  2125.         hloc := ScreenWidth div 2 - MeterWidth div 2;
  2126.         vloc := ScreenHeight div 4 - MeterHeight div 2;
  2127.         SetRect(trect, hloc, vloc, hloc + MeterWidth, vloc + MeterHeight);
  2128.         MeterWindow := NewWindow(nil, trect, '', true, dBoxProc, nil, false, 0);
  2129.         BringToFront(MeterWindow);
  2130.     end;
  2131.  
  2132.  
  2133.     procedure UpdateMeter; {(percentdone: integer; str: str255)}
  2134.         const
  2135.             left = 16;
  2136.             top = 28;
  2137.             right = 248;
  2138.             bottom = 44;
  2139.         var
  2140.             r: rect;
  2141.     begin
  2142.         if MeterWindow = nil then
  2143.             ShowMeter;
  2144.         if (percentdone >= 0) then begin
  2145.                 SetPort(MeterWindow);
  2146.                 TextFont(SystemFont);
  2147.                 TextSize(12);
  2148.                 TextMode(SrcCopy);
  2149.                 MoveTo(left, top div 2);
  2150.                 DrawString(str);
  2151.                 SetRect(r, left + StringWidth(str), 0, right, top);
  2152.                 EraseRect(r);
  2153.                 SetRect(r, left, top, right, bottom);
  2154.                 FrameRect(r);
  2155.                 SetRect(r, left + 1, top + 1, left + (percentdone * (right - left)) div 100 - 1, bottom - 1);
  2156.                 FillRect(r, gray);
  2157.             end     {then}
  2158.         else begin
  2159.                 DisposeWindow(MeterWindow);
  2160.                 MeterWindow := nil;
  2161.             end;     {else}
  2162.     end;
  2163.  
  2164.  
  2165.     function RgnNotTooBig; {(Rgn1, Rgn2: RgnHandle): boolean}
  2166.     begin
  2167.         RgnNotTooBig := GetHandleSize(handle(Rgn1)) + GetHandleSize(handle(Rgn2)) < 30000
  2168.     end;
  2169.  
  2170.  
  2171.     procedure GetSmoothedLength (var ulength, clength: real; FindPerimeter: boolean);
  2172.   {Finds the length of freehand line selections or perimeter of freehand}
  2173.   {or autotraced selections using a 3-point moving average.}
  2174.         var
  2175.             i, n: integer;
  2176.             x1, y1, x2, y2, dx, dy, xscale, yscale: real;
  2177.  
  2178.         procedure AddDelta;
  2179.         begin
  2180.             with info^ do begin
  2181.                     dx := x2 - x1;
  2182.                     dy := y2 - y1;
  2183.                     uLength := uLength + sqrt(dx * dx + dy * dy);
  2184.                     if SpatiallyCalibrated then begin
  2185.                             dx := dx / xSpatialScale;
  2186.                             dy := dy / ySpatialScale;
  2187.                             cLength := cLength + sqrt(dx * dx + dy * dy);
  2188.                         end;
  2189.                 end;
  2190.         end;
  2191.  
  2192.     begin
  2193.         with info^ do begin
  2194.                 uLength := 0.0;
  2195.                 cLength := 0.0;
  2196.                 n := nCoordinates;
  2197.                 if not CoordinatesAvailable then
  2198.                     exit(GetSmoothedLength);
  2199.                 if FindPerimeter then begin
  2200.                         x1 := (xCoordinates^[n] + xCoordinates^[1] + xCoordinates^[2]) / 3.0; {1}
  2201.                         y1 := (yCoordinates^[n] + yCoordinates^[1] + yCoordinates^[2]) / 3.0;
  2202.                     end
  2203.                 else begin
  2204.                         x1 := (xCoordinates^[1] * 2.0 + xCoordinates^[2]) / 3.0; {1}
  2205.                         y1 := (yCoordinates^[1] * 2.0 + yCoordinates^[2]) / 3.0;
  2206.                     end;
  2207.                 x2 := (xCoordinates^[1] + xCoordinates^[2] + xCoordinates^[3]) / 3.0; {2}
  2208.                 y2 := (yCoordinates^[1] + yCoordinates^[2] + yCoordinates^[3]) / 3.0;
  2209.                 AddDelta;
  2210.                 for i := 2 to n - 2 do begin
  2211.                         x1 := x2; {i}
  2212.                         y1 := y2;
  2213.                         x2 := (xCoordinates^[i] + xCoordinates^[i + 1] + xCoordinates^[i + 2]) / 3.0; {i+1}
  2214.                         y2 := (yCoordinates^[i] + yCoordinates^[i + 1] + yCoordinates^[i + 2]) / 3.0;
  2215.                         AddDelta;
  2216.                     end;
  2217.                 x1 := x2; {n-1}
  2218.                 y1 := y2;
  2219.                 if FindPerimeter then begin
  2220.                         x2 := (xCoordinates^[n - 1] + xCoordinates^[n] + xCoordinates^[1]) / 3.0; {n}
  2221.                         y2 := (yCoordinates^[n - 1] + yCoordinates^[n] + yCoordinates^[1]) / 3.0;
  2222.                         AddDelta;
  2223.                         x1 := x2; {n}
  2224.                         y1 := y2;
  2225.                         x1 := (xCoordinates^[n] + xCoordinates^[1] + xCoordinates^[2]) / 3.0; {1}
  2226.                         y1 := (yCoordinates^[n] + yCoordinates^[1] + yCoordinates^[2]) / 3.0;
  2227.                         AddDelta;
  2228.                     end
  2229.                 else begin
  2230.                         x2 := (xCoordinates^[n - 1] + xCoordinates^[n] * 2.0) / 3.0; {n}
  2231.                         y2 := (yCoordinates^[n - 1] + yCoordinates^[n] * 2.0) / 3.0;
  2232.                         AddDelta;
  2233.                     end;
  2234.                 if not SpatiallyCalibrated then
  2235.                     cLength := uLength;
  2236.             end; {with}
  2237.     end;
  2238.  
  2239.  
  2240.     procedure GetLength (var ulength, clength: real; FindPerimeter: boolean);
  2241.   {Finds the length of segmented line selections or the perimeter of polygon selections.}
  2242.         var
  2243.             i: integer;
  2244.             xtemp, ytemp: LongInt;
  2245.             xt, yt: extended;
  2246.     begin
  2247.         with info^ do begin
  2248.                 uLength := 0.0;
  2249.                 cLength := 0.0;
  2250.                 if not CoordinatesAvailable then
  2251.                     exit(GetLength);
  2252.                 for i := 2 to nCoordinates do begin
  2253.                         xtemp := xCoordinates^[i] - xCoordinates^[i - 1];
  2254.                         ytemp := yCoordinates^[i] - yCoordinates^[i - 1];
  2255.                         uLength := uLength + sqrt(xtemp * xtemp + ytemp * ytemp);
  2256.                         if SpatiallyCalibrated then begin
  2257.                                 xt := xtemp / xSpatialScale;
  2258.                                 yt := ytemp / ySpatialScale;
  2259.                                 cLength := cLength + sqrt(xt * xt + yt * yt);
  2260.                             end;
  2261.                     end;
  2262.                 if FindPerimeter then begin
  2263.                         xtemp := xCoordinates^[1] - xCoordinates^[nCoordinates];
  2264.                         ytemp := yCoordinates^[1] - yCoordinates^[nCoordinates];
  2265.                         uLength := uLength + sqrt(xtemp * xtemp + ytemp * ytemp);
  2266.                         if SpatiallyCalibrated then begin
  2267.                                 xt := xtemp / xSpatialScale;
  2268.                                 yt := ytemp / ySpatialScale;
  2269.                                 cLength := cLength + sqrt(xt * xt + yt * yt);
  2270.                             end;
  2271.                     end;
  2272.                 if not SpatiallyCalibrated then
  2273.                     cLength := uLength;
  2274.             end; {with}
  2275.     end;
  2276.  
  2277.  
  2278.     procedure GetStraightLineLength (var ulength, clength: real);
  2279.         var
  2280.             dx, dy: extended;
  2281.     begin
  2282.         with info^ do begin
  2283.                 dx := LX2 - LX1;
  2284.                 dy := LY2 - LY1;
  2285.                 uLength := sqrt(sqr(dx) + sqr(dy));
  2286.                 if SpatiallyCalibrated then
  2287.                     cLength := sqrt(sqr(dx / xSpatialScale) + sqr(dy / ySpatialScale))
  2288.                 else
  2289.                     cLength := uLength;
  2290.             end;
  2291.     end;
  2292.  
  2293.  
  2294.     procedure GetLengthOrPerimeter (var ulength, clength: real);
  2295.     begin
  2296.         case info^.RoiType of
  2297.             LineRoi: 
  2298.                 GetStraightLineLength(ulength, clength);
  2299.             PolygonRoi: 
  2300.                 GetLength(ulength, clength, true);
  2301.             FreehandRoi: 
  2302.                 GetSmoothedLength(ulength, clength, true);
  2303.             FreeLineRoi: 
  2304.                 GetSmoothedLength(ulength, clength, false);
  2305.             SegLineRoi: 
  2306.                 GetLength(ulength, clength, false);
  2307.             otherwise begin
  2308.                     ulength := 0.0;
  2309.                     clength := 0.0;
  2310.                 end;
  2311.         end;
  2312.     end;
  2313.  
  2314.  
  2315.     procedure MakeCoordinatesRelative;
  2316.         var
  2317.             i: integer;
  2318.     begin
  2319.         with info^, info^.RoiRect do begin
  2320.                 for i := 1 to nCoordinates do begin
  2321.                         xCoordinates^[i] := xCoordinates^[i] - left;
  2322.                         yCoordinates^[i] := yCoordinates^[i] - top;
  2323.                     end;
  2324.                 CoordinatesWidth := right - left;
  2325.                 CoordinatesHeight := bottom - top;
  2326.                 CoordinatesRoiType := RoiType;
  2327.             end;
  2328.     end;
  2329.  
  2330.  
  2331.     procedure MakeOutline (RoiKind: RoiTypeType);
  2332. {Creates a "marching ants" outline from a list of absolute offscreen XY coordinates.}
  2333.         var
  2334.             i: integer;
  2335.             TempRgn: RgnHandle;
  2336.             spt, pt: point;
  2337.     begin
  2338.         with Info^ do begin
  2339.                 if SelectionMode <> NewSelection then
  2340.                     TempRgn := NewRgn;
  2341.                 SetPort(wptr);
  2342.                 PenNormal;
  2343.                 OpenRgn;
  2344.                 spt.h := xCoordinates^[1];
  2345.                 spt.v := yCoordinates^[1];
  2346.                 MoveTo(spt.h, spt.v);
  2347.                 for i := 2 to nCoordinates do begin
  2348.                         pt.h := xCoordinates^[i];
  2349.                         pt.v := yCoordinates^[i];
  2350.                         LineTo(pt.h, pt.v);
  2351.                     end;
  2352.                 LineTo(spt.h, spt.v);
  2353.                 case SelectionMode of
  2354.                     NewSelection: 
  2355.                         CloseRgn(roiRgn);
  2356.                     AddSelection:  begin
  2357.                             CloseRgn(TempRgn);
  2358.                             if RgnNotTooBig(roiRgn, TempRgn) then
  2359.                                 UnionRgn(roiRgn, TempRgn, roiRgn);
  2360.                             nCoordinates := 0;
  2361.                         end;
  2362.                     SubSelection:  begin
  2363.                             CloseRgn(TempRgn);
  2364.                             if RgnNotTooBig(roiRgn, TempRgn) then
  2365.                                 DiffRgn(roiRgn, TempRgn, roiRgn);
  2366.                             nCoordinates := 0;
  2367.                         end;
  2368.                 end;
  2369.                 RoiShowing := true;
  2370.                 roiType := RoiKind;
  2371.                 RoiRect := roiRgn^^.rgnBBox;
  2372.                 UpdatePicWindow;
  2373.             end;
  2374.         if SelectionMode <> NewSelection then
  2375.             DisposeRgn(TempRgn);
  2376.         WhatToUndo := NothingToUndo;
  2377.         measuring := false;
  2378.         MakeCoordinatesRelative;
  2379.     end;
  2380.  
  2381.  
  2382.     procedure ConvertCoordinates;
  2383.   {Convert from screen to offscreen coordinates}
  2384.         var
  2385.             i: integer;
  2386.     begin
  2387.         with info^, info^.SrcRect do begin
  2388.                 if (magnification <> 1.0) or (left <> 0) or (top <> 0) then begin
  2389.                         if MakingLOI then
  2390.                             for i := 1 to nCoordinates do begin
  2391.                                     xCoordinates^[i] := left + trunc(xCoordinates^[i] / magnification);
  2392.                                     yCoordinates^[i] := top + trunc(yCoordinates^[i] / magnification);
  2393.                                 end
  2394.                         else
  2395.                             for i := 1 to nCoordinates do begin
  2396.                                     xCoordinates^[i] := left + round(xCoordinates^[i] / magnification);
  2397.                                     yCoordinates^[i] := top + round(yCoordinates^[i] / magnification);
  2398.                                 end;
  2399.                     end;
  2400.             end {with}
  2401.     end;
  2402.  
  2403.  
  2404.     procedure DrawTriangle (left, top: integer);
  2405.         var
  2406.             triangle: PolyHandle;
  2407.     begin
  2408.         triangle := OpenPoly;
  2409.         if triangle = nil then
  2410.             exit(DrawTriangle);
  2411.         MoveTo(left, top);
  2412.         LineTo(left + 12, top);
  2413.         LineTo(left + 6, top + 7);
  2414.         LineTo(left, top);
  2415.         ClosePoly;
  2416.         PaintPoly(triangle);
  2417.         KillPoly(triangle);
  2418.     end;
  2419.  
  2420.  
  2421.     procedure DrawDropBox (r: rect);
  2422.   {Draws the  drop shadow box used for pop-up menus}
  2423.     begin
  2424.         with r do begin
  2425.                 EraseRect(r);
  2426.                 FrameRect(r);
  2427.                 MoveTo(left + 2, bottom);
  2428.                 LineTo(right, bottom);
  2429.                 MoveTo(right, top + 2);
  2430.                 LineTo(right, bottom);
  2431.                 DrawTriangle(right - 15, top + 6);
  2432.             end;
  2433.     end;
  2434.  
  2435.  
  2436.     function PopUpMenu (theMenu: MenuHandle; left, top, PopUpItem: integer): integer;
  2437.   {Pops up the specified menu and returns item selected by user.}
  2438.         var
  2439.             PopupResult: LongInt;
  2440.             MenuLoc: point;
  2441.     begin
  2442.         with MenuLoc do begin
  2443.                 h := left;
  2444.                 v := top;
  2445.                 LocalToGlobal(MenuLoc);
  2446.                 PopUpResult := PopupMenuSelect(theMenu, v, h, PopUpItem);
  2447.                 PopUpMenu := LoWord(PopUpResult);
  2448.             end;
  2449.     end;
  2450.  
  2451.  
  2452.     procedure GetDItemRect (d: DialogPtr; item: integer; var r: rect);
  2453.         var
  2454.             iType: integer;
  2455.             ignore: handle;
  2456.     begin
  2457.         GetDItem(d, item, itype, ignore, r)
  2458.     end;
  2459.  
  2460.  
  2461.     procedure DrawPopUpText (str: str255; r: rect);
  2462.         var
  2463.             TextRect: rect;
  2464.     begin
  2465.         with r do begin
  2466.                 TextFont(SystemFont);
  2467.                 if (str = '+') or (str = '╨') or (str = '╓') then begin
  2468.                         TextSize(24);
  2469.                         MoveTo(left + 13, bottom - 2);
  2470.                     end
  2471.                 else begin
  2472.                         TextSize(12);
  2473.                         MoveTo(left + 13, bottom - 5);
  2474.                     end;
  2475.                 if length(str) = 1 then
  2476.                     DrawString(str)
  2477.                 else begin
  2478.                         SetRect(TextRect, left + 13, top + 1, right - 15, bottom - 1);
  2479.                         TextBox(pointer(ord(@str) + 1), length(str), TextRect, TEJustLeft);
  2480.                     end;
  2481.             end;
  2482.     end;
  2483.  
  2484.     procedure SetUProc (d: DialogPtr; item: integer; pptr: handle);
  2485.         var
  2486.             itype: integer;
  2487.             r: rect;
  2488.             h: handle;
  2489.     begin
  2490.         GetDItem(d, item, itype, h, r);
  2491.         SetDItem(d, item, itype, pptr, r);
  2492.     end;
  2493.  
  2494.  
  2495. end.